ACCESS通过VBA读取TXT不乱码（转载）

ACCESS通过VBA读取TXT不乱码（转载）
ACCESS通过VBA读取TXT不乱码（转载）
2010-07-06 07:43
昨天帮领导做了一个TOOLS，功能是把一个文件夹下的所有TXT 文件，按照特定的方式读取出来，进行筛选，
由于我觉得筛选逻辑比较复杂，所以我采用了ACCESS的读取方式，把TXT内容读取到数据库中，然后通过SQL问进行筛选。

上来就遇到了问题ACCESS的VBA读取TXT读进去的都乱码，尝试了各种方式，都是如此，后来灵机一动放弃了文件的单纯读取，通过读取EXCEL的方式读取，居然成功了，分享一下给大家。

Option Compare Database
Private Sub 実行_Click()
' Dim txtLine As String
' Dim FileObj As Object
' Dim TextObj As Object
' Dim FilePath
' Dim MyPath$, MyFile$
' Dim fs, f
'Const ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0
'
' Set fs = CreateObject("Scripting.FileSystemObject")
' Set f = fs.OpenTextFile("D:\tools\result.txt", 8, True, TristateFalse)
'
' FilePath = txtPATH.Value
'
' MyPath = FilePath & "\*.*"
' MyFile = Dir(MyPath)
' Do
' Debug.Print MyFile
' If MyFile <> "" Then
' Set FileObj = CreateObject("Scripting.FileSystemObject")
' Set TextObj = FileObj.OpenT extFile(FilePath & "\" & MyFile, ForReading, TristateTrue)
' Do While Not TextObj.AtEndOfLine
' txtLine = Trim(T extObj.ReadLine)
' 'If InStr(txtLine, "タイプ作成中") > 0 Then
' f.writeline txtLine & vbCrLf
' 'End If
' Loop
' End If
' MyFile = Dir
' Loop Until MyFile = ""
' f.Close
'--------------------------------------------------------------------------------------
' Dim txtLine As String
' Dim FileObj As Object
' Dim TextObj As Object
' Dim FilePath
' Dim MyPath$, MyFile$
' Dim fs, f
'Const ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0
'
' Set fs = CreateObject("Scripting.FileSystemObject")
' Set f = fs.OpenTextFile("D:\tools\result.txt", 8, True, TristateFalse)
'
' FilePath = txtPATH.Value
'
' MyPath = FilePath & "\*.*"
' MyFile = Dir(MyPath)
' Do
' Debug.Print MyFile
' If MyFile <> "" Then
' Dim strRtn As String
' Set stm = New ADODB.Stream
' stm.Type = 2
' stm.Mode = 3
' stm.Charset = "UTF-8"
' stm.Open
' stm.LoadFromFile FilePath & "\" & MyFile
' strRtn = stm.ReadText
' stm.Close
' Set stm = Nothing
' ReadFromFileADO = strRtn
' End If
' MyFile = Dir
' Loop Until MyFile = ""
' f.Close
'-----------------------------------
' Dim txtLine As String
' Dim FileObj As Object
' Dim TextObj As Object
' Dim FilePath
' Dim MyPath$, MyFile$
' Dim fs, f
'Const ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0
'
' Set fs = CreateObject("Scripting.FileSystemObject")
' Set f = fs.OpenTextFile("D:\tools\result.txt", 8, True, TristateFalse)
'
' FilePath = txtPATH.Value
'
' MyPath = FilePath & "\*.*"
' MyFile = Dir(MyPath)
' Do
' Debug.Print MyFile
' If MyFile <> "" Then
' Dim ff As String
' Dim Txt() As String
' Dim i As Integer
' i = 0
'
' ff = FilePath & "\" & MyFile
' Open ff For Input As #1
' Do Until EOF(1)
' Line Input #1, txtLine
'
' i = i + 1
' Loop
' Close #1
' End If
' MyFile = Dir
' Loop Until MyFile = ""
Dim txtLine As String
Dim FileObj As Object
Dim TextObj As Object
Dim FilePath
Dim MyPath$, MyFile$
Dim fs, f
Dim EXEファイル名(1 To 10000) As String
Dim 机能(1 To 10000) As String
Dim PBL名(1 T o 10000) As String
Dim Object名(1 To 10000) As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Set xlApp = New Excel.Application
Dim sheet As Excel.Worksheet
Dim FLAG As Integer
Const ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0
Set fs = CreateObject("Scripting.FileSystemObject")
FLAG = 0
FilePath = txtPATH.Value
MyPath = FilePath & "\*.*"
MyFile = Dir(MyPath)
Do
Debug.Print MyFile
If MyFile <> "" Then
Set xlBook = xlApp.Workbooks.Open(FilePath & "\" & MyFile) Set sheet = xlBook.Worksheets(1)
Dim ss As String
Dim a
For a = 1 To edRange.Rows.count - 1
ss = sheet.Cells(a, 1)
If InStr(ss, "タイプ作成中") > 0 Then
FLAG = 1
If InStr(ss, "pbl_exe_ver11a") = 0 Then
ss = Mid(ss, InStr(ss, "pbl_exe_ver11") + Len("pbl_exe_ver11") + 1)
Else
ss = Mid(ss, InStr(ss, "pbl_exe_ver11a") + Len("pbl_exe_ver11a") + 1)
End If
EXEファイル名(a) = Left(MyFile, InStr(MyFile, ".") - 1)
If InStr(ss, "\") = 0 Then
' 机能(a) = "共通"
' PBL名(a) = Left(ss, InStr(ss, "(") - 1)
' Object名(a) = Left(Mid(ss, InStr(ss, "(") + 1), Len(Mid(ss, InStr(ss, "(") + 1)) - 7)
Else
机能(a) = Left(ss, InStr(ss, "\") - 1)
PBL名(a) = Left(Split(ss, "\")(1), InStr(Split(ss, "\")(1), "(") - 1) Object名(a) = Left(Split(ss, "(")(1), InStr(Split(ss, "(")(1), ")") - 1)
DoCmd.SetWarnings False
DoCmd.RunSQL ("INSERT INTO Logtable(EXEファイル名,机能,PBL名,Object名) VALUES('" & EXEファイル名(a) & "','" & 机能(a) & "','" & PBL名(a) & "','" & Object名(a) & "')")
DoCmd.SetWarnings True
End If
ElseIf FLAG = 1 Then
FLAG = 0
Exit For
End If
Next a
End If
MyFile = Dir
Loop Until MyFile = ""
Set sheet = Nothing
xlBook.Close (True)
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "Success"
AllDataのサブフォーム.Requery
'Dim i As Long
'i = Shell("cmd.exe /c taskkill /f /im excel.exe", vbNormalFocus)
' Dim i As Long
' Dim r As Long
' Dim p As Long
' i = Shell("notepad.exe", vbNormalFocus)
' p = OpenProcess(SYNCHRONIZE, False, i)
' r = WaitForSingleObject(p, INFINITE)
' r = CloseHandle(p) End Sub。