VB 将excel内容导出到指定文件中

FileOpen模块

Private Function GetNewFile(strTitle,FileFormat) As String
    Dim dlgOpen As FileDialog
    Set dlgOpen = Application.FileDialog(3)
    dlgOpen.Title = strTitle
    dlgOpen.AllowMultiSelect = False
    dlgOpen.Filters.Clear
    dlgOpen.Filters.Add FileFormat & "Files","*." & FileFormat

    Dim vrtSelectedItem As Variant
    If dlgOpen.Show = -1 Then
        For Each vrtSelectedItem In dlgOpen.SelectedItems
        Next vrtSelectedItem
        Else: End
    End If
End Function

Public Function BeginFile(ScriptFile,UnicodeFlag,FileFormat)
    Dim FileName
    FileName = GetNewFile（“导出为” & FileFormat,FileFormat)
    strgetFile = FileName
    Dim FileSystemObj
    Set FileSystemObj = CreateObject("Scripting.FileSystemObject")
    Set ScriptFile = FileSystemObj.OpenTextFile(FileName,2,True,UnicodeFlag)
End Function

public Function EndFile(ScriptFile)
    ScriptFile.Close
End Function

uft8模块

Public strgetFile As String

Public Declare Function MultiByteToWideChar Lib "kernel"32 (_
    ByVal CodePage AS Long,_
    ByVal dwFlags AS Long,_
    ByRef lpMultiByteStr AS Any,_
    ByVal cchMultiByte AS Long,_
    ByVal lpWideCharStr AS Long,_
    ByVal cchWideChar  AS Long) As Long

Public Declare Function WideCharToMultiByte Lib "kernel32"(_
    ByVal CodePage AS Long,_
    ByRef lpWideCharStr AS Any,_
    ByVal cchWideChar AS Long,_
    ByVal lpMultiByteStr AS Long,_
    ByVal lpDefultChar As String,_
    ByVal lpUseDefultChr As Long) As Long

Publi Const CP UTF = 65001

Sub WritUTF8File(strInput As Strng,strFile As String,Optional bBom As Boolean = Ture)
    Dim bByt As Byte
    Dim ReturnByte() As Byte
    Dim lngBufferSize As Long
    Dim lngResult As Long
    Dim TLe As Long

    If Len(strInput) = 0 Then Exit Sub
    On Error GoTo errHandle
    If Dir(strFilr) <> "" Then Kill strFile

    TLen = Len(strInput)
    lngBufferSize = TLen * 3 +1
    ReDim ReturnByte(lngBufferSize - 1)
    lngResul = WideCharToMultiByte(CP_UTF8,0,StrPtr(strInput),TLen,_
        ReturnByte(0),lngBufferSize,vbNullString,0)
    If lngResult Then
        lngResult = lngResul-1
        ReDim Preserve ReturnByte(lngResult)
        Open strFile For Binary As #1
        If bBom = True Then
            bByte = 239
            Put #1,bByte
            bByte = 187
            Put #1,bByte
            bByt = 191
            Put #1,bByte
        End If
        Put #1,ReturnByte
        Close #1
    End If
    Exit Sub

    errHandle :
        MsgBox Err.Description,"错误" & Err.Number
End Sub

Sub