Question

嘿伙计们我的代码卡住了，无法继续下去...... （我很喜欢maby）

这是我的代码：

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, MyFile, FileName, TextLine
Dim TextArray()
Dim x As Double
Dim SQLString


Set fso = CreateObject("Scripting.FileSystemObject")

FileName = "C:\Users\ava\Desktop\TEST_IMPORT\1.txt"

Set MyFile = fso.OpenTextFile(FileName, ForReading)


Do While MyFile.AtEndOfStream <> True
    ReDim Preserve TextArray(x)
    TextLine = MyFile.ReadLine
    TextArray(x) = TextLine
    x = x + 1

Loop

MyFile.Close

SQLString = "INSERT INTO TEST_TAB (Layout, Anzahl_Etiketten, Anzahl_Verpackungseinheiten, Bezeichnung1, Selektionsnummer, Bezeichnung2, Barcode, LA_Nummer, RM_Nummer, Bezeichnung3, Teilenummer) VALUES ('" & TextArray(0) & "','" & TextArray(1) & "','" & TextArray(4) & "','" & TextArray(5) & "','" & TextArray(6) & "','" & TextArray(7) & "','" & TextArray(9) & "','" & TextArray(10) & "','" & TextArray(13) & "','" & TextArray(15) & "','" & TextArray(19) & "');"

DoCmd.SetWarnings (WarningsOff)

DoCmd.RunSQL SQLString

DoCmd.SetWarnings (WarningsOn)

End Sub

代码导入我桌面的文本文件（1.txt）然后将数据导入我的访问数据库

这适用于我的一个文件。（1.txt的）

我发现This Link如何循环浏览文件夹......

我如何在我的代码中实现它？

感谢您提供进一步的帮助！

Answer 1

我假设您正在阅读.txt文件夹中扩展名为C:\Users\ava\Desktop的每个文件。

试试这个......

Dim TextArray()
Dim x As Double
Dim SQLString

Set fso = CreateObject("Scripting.FileSystemObject")

strFolder= "C:\Users\ava\Desktop" 'sets folder
strFileName = Dir(strFolder & "\*.txt") 'grabs first txt file

Do While strFileName <> 0 'starts loop
    FileName = strFileName 'set filename

    Set MyFile = fso.OpenTextFile(FileName, ForReading)

    '' Read from the file
    Do While MyFile.AtEndOfStream <> True
            ReDim Preserve TextArray(x)
            TextLine = MyFile.ReadLine
            TextArray(x) = TextLine
            x = x + 1   
    Loop

    MyFile.Close

    SQLString = "INSERT INTO TEST_TAB (Layout, Anzahl_Etiketten, Anzahl_Verpackungseinheiten, Bezeichnung1, Selektionsnummer, Bezeichnung2, Barcode, LA_Nummer, RM_Nummer, Bezeichnung3, Teilenummer) VALUES ('" & TextArray(0) & "','" & TextArray(1) & "','" & TextArray(4) & "','" & TextArray(5) & "','" & TextArray(6) & "','" & TextArray(7) & "','" & TextArray(9) & "','" & TextArray(10) & "','" & TextArray(13) & "','" & TextArray(15) & "','" & TextArray(19) & "');"

    DoCmd.SetWarnings (WarningsOff)

    DoCmd.RunSQL SQLString

    DoCmd.SetWarnings (WarningsOn)

    strFileName = Dir 'Grabs next txt file
Loop

Answer 2

我不确定你为什么一遍又一遍地使用TextArray，但考虑这样做。

Option Compare Database

Private Sub Command0_Click()


        Dim strPathFile As String, strFile As String, strPath As String
        Dim strTable As String
        Dim blnHasFieldNames As Boolean

        ' Change this next line to True if the first row in EXCEL worksheet
        ' has field names
        blnHasFieldNames = True

        ' Replace C:\Documents\ with the real path to the folder that
        ' contains the EXCEL files
        strPath = "C:\Users\rschuell\Desktop\test\"

        ' Replace tablename with the real name of the table into which
        ' the data are to be imported
        strTable = "tablename"

        strFile = Dir(strPath & "*.txt")
        Do While Len(strFile) > 0
              strPathFile = strPath & strFile

              DoCmd.TransferText _
                TransferType:=acImportDelim, _
                TableName:=strTable, _
                FileName:=strPathFile, _
                HasFieldNames:=blnHasFieldNames


        ' Uncomment out the next code step if you want to delete the
        ' EXCEL file after it's been imported
        '       Kill strPathFile

              strFile = Dir()
        Loop



End Sub

如何循环浏览文件夹并将所有文件导入Access（VBA）

2 个答案: