Sub ToSql()
    Dim Sh As Worksheet, Sql As String, Sq As String
    Dim Zpt As String, FileName As String
    Set C_is = CreateObject("scripting.dictionary")

    FileName = ThisWorkbook.Path & "\Sql.sql"
    Set Sh = ThisWorkbook.Worksheets(1)
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    LastColl = Sh.Cells(1, Sh.Columns.Count).End(xlToLeft).Column
    dx = Sh.Range(Sh.Cells(1, 1), Sh.Cells(LastRow, LastColl))
    a = Array(1, 2, 3, 14, 15, 16, 17)
    For n = 0 To UBound(a)
        C_is.Item(a(n)) = n
    Next
    Sql = "insert into `t_olx` ("
    For n = 1 To UBound(dx, 2)
        If n = 1 Then
            Sql = Sql & dx(1, n)
        Else
            Sql = Sql & "," & dx(1, n)
        End If
    Next
    Sql = Sql & ") values" & vbCrLf

    For n = 2 To UBound(dx)
        If Sq <> "" Then Sq = Sq & ","
        Sq = Sq & "("
        For i = 1 To UBound(dx, 2)
            If i = 1 Then
                Zpt = ""
            Else
                Zpt = ","
            End If
            If C_is.Exists(i) Then
                Sq = Sq & Zpt & dx(n, i) & ""
            Else
                If InStr(1, dx(n, i), "'", vbTextCompare) > 0 Then
                    dx(n, i) = Replace(dx(n, i), "'", Chr(34))
                End If
                Sq = Sq & Zpt & "'" & dx(n, i) & "'"
            End If

        Next
        Sq = Sq & ")" & vbCrLf
    Next
    Sql = Sql & Sq
    Writer_To Sql, FileName

End Sub
Function Writer_To(strUnicode As String, FileName As String)
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const bOverwrite = True
    Const bAsASCII = False
    Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject")
    Dim oTo: Set oTo = CreateObject("ADODB.Stream")
    Dim sTFSpec: sTFSpec = oFS.GetAbsolutePathName(FileName)
    If oFS.FileExists(sTFSpec) Then oFS.DeleteFile sTFSpec
    oTo.Type = adTypeText
    oTo.Charset = "utf-8"
    oTo.Open
    oTo.WriteText strUnicode
    oTo.SaveToFile sTFSpec
    oTo.Close
    Set oFS = Nothing
    Set oTo = Nothing
End Function