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