Write the result of SQL-query in file with encoding UTF-8 without BOM

Скрипт позволяет выгрузить результат 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
Реклама