Sub Test()
    Dim sht As Worksheet, scr, content As String, i, arr_acsp_xz(1 To 8), arr_acsp_xz_data(1 To 8), arr_wemzs(1 To 13), arr_wemzs_data(1 To 13), temp
    Set sht = ThisWorkbook.Worksheets("小组")
    
    scr = "<script>" + vbCrLf
    scr = scr + "var mydata;" + vbCrLf
    scr = scr + "mydata = {" + vbCrLf
    
    scr = scr & "    cljsl:" & Round(sht.Range("N11").Value * 100, 2) & "," + vbCrLf
    scr = scr & "    myl:" & Round(sht.Range("W11").Value * 100, 2) & "," + vbCrLf
    
    '小组
    For i = 1 To 8
        arr_acsp_xz(i) = "'" & sht.Cells(i + 2, 1) & "'"
        arr_acsp_xz_data(i) = "" & Round(sht.Cells(i + 2, "R") * 100, 2) & ""
    
    Next
    
    scr = scr & "    acsp_xz:[" & Join(arr_acsp_xz, ",") & "]," + vbCrLf
    scr = scr & "    acsp_xz_data:[" & Join(arr_acsp_xz_data, ",") & "]," + vbCrLf
    
    
    '地区
    For i = 1 To 13
        arr_wemzs(i) = "'" & sht.Cells(i + 15, "A") & "'"
        arr_wemzs_data(i) = "" & sht.Cells(i + 15, "D") & ""
    Next
    ReDim temp(1 To 13)
    For i = 1 To 13
        temp(i) = "{name:" & arr_wemzs(i) & ",value:" & arr_wemzs_data(i) & "}"
    Next
      
    
    scr = scr & "    wemzs:[" & Join(temp, ",") & "]," + vbCrLf
    scr = scr & "    wemzs_max: " & application.worksheetfunction.max(arr_wemzs_data) & vbCrLf
    
    
    scr = scr + "}" + vbCrLf
    scr = scr + "</script>"
    Set sht = Nothing
    
    
    content = ReadUTF("E:\工作\kb7.26 - 副本\index-template.html")
    content = Replace(content, "{{data}}", scr)
    WriteUTF "E:\工作\kb7.26 - 副本\index.html", content
    
End Sub

Function ReadUTF(ByVal FileName As String) As String
    With CreateObject("ADODB.Stream")
        .Type = 2    '读取文本文件
        .Mode = 3   '读写
        .Open    '打开流
        .LoadFromFile FileName   '装载文本文件
        .Charset = "UTF-8"  '设定编码
        .Position = 2
        ReadUTF = .ReadText   '读取文本
        .Close       '关闭
    End With
End Function

Private Sub WriteUTF(strPath As String, str As String)

    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    
    With objStream
        .Type = 2               'adTypeText
        .Charset = "UTF-8"
        .Open
        .WriteText str
        .SaveToFile strPath, 2  'adSaveCreateOverWrite
    End With
    
    Set objStream = Nothing
End Sub

 Sub test()
  Dim WriteStream As Object, BinSt As Object
  Dim name As String
  Dim nameto As String
  Set WriteStream = CreateObject("ADODB.Stream")
  Set BinSt = CreateObject("ADODB.Stream")
  nameto = "指定一个文件全路径 如：“D:\1.sql”"
  With WriteStream
  	.Open
    .Charset = "UTF-8"
    .Type = 2               'adTypeText  （文本）
    .WriteText ("insert into name values('1','2','3')")
    .Position = 3
  End With
  With BinSt
    .Open
    .Type = 1              '（字节）
  End With
  WriteStream.CopyTo BinSt '数据复制
  With BinSt
  	.SaveToFile nameto, 2	'保存文件
    .Close
  End With
  WriteStream.Close
  Set WriteStream = Nothing
  Set BinSt = Nothing
  Application.ScreenUpdating = True
  MsgBox "test over"	
 End Sub