Скрипт позволяет выгрузить результат SQL-запроса (MS SQL Server) в текстовый файл с разделителями в кодировке UTF-8 без BOM.
Dim oSource Dim oDatabase Dim oUser Dim oPassword Dim conn Dim cmd Dim rs Dim fs Dim arr Dim textStream Dim FileName Dim strLine, Str Dim Res Dim sep Dim i Dim dblQuate 'Enter settings for connecting to MS SQL database oSource = "mssqlsrv" oDatabase = "hwiproducts" oUser = "hwiuser" oPassword = "*******" Set conn = CreateObject("ADODB.Connection") conn.Open "Provider=SQLOLEDB;Data Source=" _ & oSource & ";Trusted_Connection=Yes;Initial Catalog=" _ & oDatabase & ";User ID=" & oUser & ";Password=" & oPassword & "" Set cmd = CreateObject("ADODB.Command") Set cmd.ActiveConnection = conn 'Place your SQL-Query cmd.CommandText = "SELECT TYPENAME, " _ & "MDNAME, " _ & "SN, " _ & "STRIHCODE, " _ & "VENDOR, " _ & "convert(varchar(20), INDEMNITYD, 120) INDEMNITYD, " _ & "convert(varchar(20),GUARANT,120) GUARANT, " _ & "DEP " _ & "FROM [hwiproducts].[dbo].[productstores]" _ & "WHERE TYPEEQU = 'Printers'" 'Execute your SQL-Query Set rs = cmd.Execute 'Specify the full path to the file to which we write the query result FileName = "d:\PLANTRACE\HWI\Printers.csv" Set fs = CreateObject("Scripting.FileSystemObject") 'Check the existence of the file and delete it (if necessary) If fs.FileExists(FileName) Then fs.DeleteFile(FileName) End If Set textStream = fs.OpenTextFile(FileName, 8, True) 'Specifies the separator sep = "," Do Until rs.EOF 'Count the number of fields ColCount = rs.Fields.Count - 1 For i = 0 To ColCount 'Add double quotes to values (if necessary) dblQuate = """"& rs(rs.Fields(i).Name) &"""" 'Form a string to write to the file strLine = strLine & sep & dblQuate If i = ColCount Then 'Separator to remove from the beginning of the string Str = Replace(strLine,",","",1,1) 'Convert string to UTF-8 without BOM and write it in file Res = StrConvert (Str, "Windows-1251", "UTF-8") textStream.WriteLine Res 'When a string is writed then clean it strLine = "" End If Next 'Next row from result query rs.MoveNext Loop 'Close stream, command and connecting textStream.Close rs.Close conn.Close Function StrConvert(Text, FromCharset, ToCharset) 'What's: converts the string in encoding UTF8 without BOM Dim Stream Set Stream = CreateObject("ADODB.Stream") Stream.Type = 2 Stream.Mode = 3 Stream.Open Stream.Charset = ToCharset Stream.WriteText Text Stream.Position = 0 Stream.Charset = FromCharset BOM = Stream.ReadText(3) 'Skip BOM bytes If AscB(MidB(BOM, 1, 1)) = 239 And AscB(MidB(BOM, 2, 1)) = 187 _ And AscB(MidB(BOM, 3, 1)) = 191 Then Stream.Position = 3 Set fOut = CreateObject("adodb.stream") fOut.Type = 2 fOut.Mode = 3 fOut.Open fOUT.WriteText Text StrConvert = fOUT.ReadText Else StrConvert = Stream.ReadText End If End Function