我目前正在使用 Application.GetOpenFilename 和MultiSelect：= True，以允许用户选择文件夹中的一个或多个文件，然后将所有文件中的数据导入工作表。如果选择了多个文件，则每个文件中的数据将附加到上一个文件中的数据，直到导入所有选定的文件为止。
我现在有一个实例，其中文本文件存储在特定文件夹的子文件夹中，子文件夹基于订单号创建。我现在尝试将父文件夹定义为变量，允许用户使用 Application.InputBox 输入子文件夹名称，然后自动从用户指定的子文件夹中的所有.txt文件中导入数据。我遇到了运行时错误＆＃39; 53＆＃39;，找不到文件错误。我知道使用GetOpenFilename方法创建了一个文件名数组，我试图通过创建一个文件名数组来复制它，但我显然遗漏了一些东西。
我基本上尝试从以下内容导入所有.txt文件：
C：\ AOI_DATA64 \ SPC_DataLog \ IspnDetails \ 用户定义的子文件夹 \ * .txt
使用 Application.GetOpenFilename ：
运行的代码' Define that variables must be defined manually and will never be defined automatically
Option Explicit
' Hold specific variables in memory for use between sub-routines
Public DDThreshold As Variant
Public FileName As String
Public FilePath As String
Public OpenFileName As Variant
Public OrderNum As Variant
Public SaveWorkingDir As String
Public SecondsElapsed As Double
Public StartTime As Double
Public TimeRemaining As Double
Sub Import_DataFile()
' Add an error handler
' On Error GoTo ErrorHandler
' Speed up this sub-routine by turning off screen updating and auto calculating until the end of the sub-routine
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Define variable names and types
Dim DefaultOpenPath As String
Dim SaveWorkingDir As String
Dim OpenFileName As Variant
Dim WholeFile As String
Dim SplitArray
Dim LineNumber As Integer
Dim chkFormat1 As String
Dim i As Long
Dim n1 As Long
Dim n2 As Long
Dim fn As Integer
Dim RawData As String
Dim rngTarget As Range
Dim rngFileList As Range
Dim TargetRow As Long
Dim FileListRow As Long
Dim aLastRow As Long
Dim bLastRow As Long
Dim cLastRow As Long
Dim dLastRow As Long
Dim destCell As Range
' Set the default path to start at when importing a file
'On Error Resume Next
If Len(Dir("C:\AOI_DATA64\SPC_DataLog\IspnDetails", vbDirectory)) = 0 Then
DefaultOpenPath = "C:\"
Else
DefaultOpenPath = "C:\AOI_DATA64\SPC_DataLog\IspnDetails\"
End If
' When opening another file for processing, this section will save the previously opened file directory
'On Error Resume Next
If SaveWorkingDir = CurDir Then
ChDrive SaveWorkingDir
ChDir SaveWorkingDir
Else
ChDrive DefaultOpenPath
ChDir DefaultOpenPath
End If
' Select the source folder and point list file(s) to import into worksheet
'On Error GoTo ErrorHandler
OpenFileName = Application.GetOpenFilename( _
FileFilter:="AOI Inspection Results Data Files (*.txt), *.txt", _
Title:="Select a data file or files to import", _
MultiSelect:=True)
' Cancel the file import if the user exits the file import window or selects the Cancel button
If Not IsArray(OpenFileName) Then
MsgBox "" & vbNewLine & _
" No files were selected." & vbNewLine & _
"" & vbNewLine & _
" Import AOI Inspection Results Data Files was aborted.", vbInformation, "File Import Cancelled"
Exit Sub
End If
' Clear contents and reset formatting of cells in all worksheets
aLastRow = Worksheets("AOI Inspection Summary").Cells(Rows.Count, "B").End(xlDown).Row
bLastRow = Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlDown).Row
cLastRow = Worksheets("Parsed Data").Cells(Rows.Count, "A").End(xlDown).Row
Worksheets("AOI Inspection Summary").Range("E6:L14").ClearContents
If aLastRow > 0 Then
Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearContents
Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearFormats
End If
If bLastRow > 0 Then
Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearContents
Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearFormats
End If
If cLastRow > 0 Then
Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearContents
Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearFormats
End If
Worksheets("AOI Inspection Summary").Range("E6:L9").NumberFormat = "@" 'Format cells to Text
Worksheets("AOI Inspection Summary").Range("E10:L13").NumberFormat = "#,000" 'Format Cells to Number with commas
Worksheets("AOI Inspection Summary").Range("E14:L14").NumberFormat = "0.00%" 'Format cells to Percent
Worksheets("Raw Data").Columns("A:Z").EntireColumn.ColumnWidth = 8.09
Worksheets("Parsed Data").Columns("A:Z").EntireColumn.ColumnWidth = 8.09
' Update "Defect Density Threshold" to default value unless user entered a new value
If DDThreshold > 0 Then
Worksheets("AOI Inspection Summary").Range("E10").Value = DDThreshold
Else
Worksheets("AOI Inspection Summary").Range("E10").Value = "3,000,000"
End If
' Save the user selected open file directory as the default open file path while the worksheet is open
SaveWorkingDir = CurDir
' Timer Start (calculate the length of time this sub-routine takes to complete after selecting file(s) to import)
StartTime = Timer
' Check selected input file format for YesTech AOI Inspection Results format
Const chkYesTech = "[StartIspn]"
For n1 = LBound(OpenFileName) To UBound(OpenFileName)
fn = FreeFile
Open OpenFileName(n1) For Input As #fn
Application.StatusBar = "Processing ... " & OpenFileName(n1)
WholeFile = Input(LOF(fn), #fn)
SplitArray = Split(WholeFile, vbCrLf)
LineNumber = 1
chkFormat1 = SplitArray(LineNumber - 1)
Close #fn
If InStr(1, chkFormat1, chkYesTech, vbBinaryCompare) > 0 Then
MsgBox OpenFileName(n1) & vbNewLine & " has been verified as a YesTech AOI Inspection Results Data File"
' Import user selected YesTech AOI Inspection Results Data File(s) to "Raw Data" worksheet
Application.DisplayAlerts = False
TargetRow = 0
Set destCell = Worksheets("Raw Data").Range("B1")
For n2 = LBound(OpenFileName) To UBound(OpenFileName)
fn = FreeFile
Open OpenFileName(n2) For Input As #fn
Application.StatusBar = "Processing ... " & OpenFileName(n2)
' Import data from file into Raw Data worksheet
Do While Not EOF(fn)
Line Input #fn, RawData
If Len(Trim(RawData)) > 0 Then
TargetRow = TargetRow + 1
Worksheets("Raw Data").Range("B" & TargetRow) = RawData
End If
Loop
Next n2
Close #fn
Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlDown).Address)
With rngTarget
.TextToColumns Destination:=destCell, DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, OtherChar:="|", _
FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End With
Application.DisplayAlerts = True
Else: MsgBox OpenFileName(n1) & vbNewLine & " is not a YesTech AOI Inspection Results Data File."
Exit Sub
End If
Next
' Create a number list (autofill) in Col A to maintain original import sort order
dLastRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Raw Data").Range("A1:A" & dLastRow).Font.Color = RGB(200, 200, 200)
Worksheets("Raw Data").Range("A1") = "1"
Worksheets("Raw Data").Range("A2") = "2"
Worksheets("Raw Data").Range("A1:A2").AutoFill Destination:=Worksheets("Raw Data").Range("A1:A" & dLastRow), Type:=xlFillDefault
Worksheets("Raw Data").Range("F1:Q" & dLastRow).NumberFormat = "0.0"
' List open file name(s) on spreadsheet for user reference
Worksheets("AOI Inspection Summary").Range("E9").Font.Name = "Calibri"
Worksheets("AOI Inspection Summary").Range("E9").Font.Size = 9
Worksheets("AOI Inspection Summary").Range("E9").Font.Bold = False
Worksheets("AOI Inspection Summary").Range("E9").Font.Color = RGB(0, 0, 255)
FileListRow = 0
Set rngFileList = Worksheets("AOI Inspection Summary").Range("E9")
For i = LBound(OpenFileName) To UBound(OpenFileName)
' Add imported file name hyperlink to imported files in list of imported files
' rngFileList.Offset(FileListRow, 0) = OpenFileName(i)
rngFileList.Hyperlinks.Add Anchor:=rngFileList, _
Address:=OpenFileName(i), _
ScreenTip:="Imported File Number " & FileListRow + 1, _
TextToDisplay:=OpenFileName(i)
Worksheets("AOI Inspection Summary").Range("E7").Value = OpenFileName(i)
FileListRow = FileListRow + 1
Next i
' Auto fit the width of columns for RAW Data
Worksheets("Raw Data").Columns("A:Z").EntireColumn.AutoFit
' Timer Stop (calculate the length of time this sub-routine took to complete)
SecondsElapsed = Round(Timer - StartTime, 2)
' Turn screen updating and auto calculating back on since file processing is now complete
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
' Display a message to report the sub-routine processing time after file selection including the number of data rows that have been imported
MsgBox "AOI Inspection Results processed and imported in " & SecondsElapsed & " seconds" & " ." & vbNewLine & _
" Successfully imported " & (TargetRow) & " rows of data.", vbInformation, "Data Import Results"
' Reset to defaults in the event of a processing error during the sub-routine execution
ErrorHandler:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
If Err.Number <> 0 Then
' Display a message to user including error code in the event of an error during execution
MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _
"Part or all of this VBA script was not completed.", vbInformation, "Error Message"
End If
Call Create_Report
End Sub
我尝试定义父文件夹，使用Application.InputBox向用户询问子文件夹名称，并将所有* .txt文件名加载到要导入的数组中：
' Define that variables must be defined manually and will never be defined automatically
Option Explicit
' Hold specific variables in memory for use between sub-routines
Public DDThreshold As Variant
Public FileName As String
Public FilePath As String
Public OpenFileName As Variant
Public OrderNum As Variant
Public SaveWorkingDir As String
Public SecondsElapsed As Double
Public StartTime As Double
Public TimeRemaining As Double
Sub OrderLineNum()
' Add an error handler
'On Error GoTo ErrorHandler
' Speed up sub-routine by turning off screen updating and auto calculating
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Define variable names and data types
Dim DefaultOpenPath As String
Dim SaveWorkingDir As String
Dim OrderNum As Variant
Dim GetFile As String
Dim FileCount As Long
Dim OpenFileName() As String
ReDim OpenFileName(1000)
Dim WholeFile As String
Dim SplitArray
Dim LineNumber As Integer
Dim chkFormat1 As String
Dim i As Long
Dim n1 As Long
Dim n2 As Long
Dim fn As Integer
Dim RawData As String
Dim rngTarget As Range
Dim rngFileList As Range
Dim TargetRow As Long
Dim FileListRow As Long
Dim aLastRow As Long
Dim bLastRow As Long
Dim cLastRow As Long
Dim dLastRow As Long
Dim destCell As Range
' Set the default path to start at when importing a file
' On Error Resume Next
If Len(Dir("C:\AOI_DATA64\SPC_DataLog\IspnDetails", vbDirectory)) = 0 Then
DefaultOpenPath = "C:\"
Else
DefaultOpenPath = "C:\AOI_DATA64\SPC_DataLog\IspnDetails\"
End If
' When opening another file for processing, save the previously opened file directory
' On Error Resume Next
If SaveWorkingDir = CurDir Then
ChDrive SaveWorkingDir
ChDir SaveWorkingDir
Else
ChDrive DefaultOpenPath
ChDir DefaultOpenPath
End If
' Open InputBox to get order-line number from user
OrderNum = Application.InputBox(prompt:= _
"Enter Order-Line Number (e.g. 12345678-9)", _
Title:="Password Required for This Function", _
Default:="", _
Left:=25, _
Top:=25, _
HelpFile:="", _
HelpContextID:="", _
Type:=2)
If OrderNum = "" Then
MsgBox "No Order Number entered. No data will be imported.", vbInformation, "Invalid Order Number"
Exit Sub
ElseIf OrderNum = "0" Then
MsgBox "Order Number cannot be 0. No data will be imported.", vbInformation, "Invalid Order Number"
Exit Sub
ElseIf OrderNum = False Then
MsgBox "User cancelled. No data will be imported.", vbInformation, "User Cancelled"
Exit Sub
End If
' Create an array of filenames found in the Order-Line Number sub-folder
GetFile = Dir$(CurDir & "\" & OrderNum & "\" & "*.txt")
Do While GetFile <> ""
OpenFileName(FileCount) = GetFile
GetFile = Dir$
FileCount = FileCount + 1
Loop
ReDim Preserve OpenFileName(FileCount - 1)
' Save the user selected open file directory as the default open file path while the worksheet is open
SaveWorkingDir = CurDir
' Timer Start (calculate the length of time this sub-routine takes to complete after selecting file(s) to import)
StartTime = Timer
' Cancel the file import if the Order-Line Number subfolder doesn't exist
If Not IsArray(OpenFileName) Then
MsgBox "" & vbNewLine & _
" No files were selected." & vbNewLine & _
"" & vbNewLine & _
" Import AOI Inspection Results Data Files was aborted.", vbInformation, "File Import Cancelled"
Exit Sub
End If
' Clear contents of cells and data worksheets
aLastRow = Worksheets("AOI Inspection Summary").Cells(Rows.Count, "B").End(xlDown).Row
bLastRow = Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlDown).Row
cLastRow = Worksheets("Parsed Data").Cells(Rows.Count, "A").End(xlDown).Row
Worksheets("AOI Inspection Summary").Range("E6:L14").ClearContents
If aLastRow > 0 Then
Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearContents
Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearFormats
End If
If bLastRow > 0 Then
Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearContents
Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearFormats
End If
If cLastRow > 0 Then
Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearContents
Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearFormats
End If
' Update "Defect Density Threshold" to default value unless user entered a new value
If DDThreshold > 0 Then
Worksheets("AOI Inspection Summary").Range("E10").Value = DDThreshold
Else
Worksheets("AOI Inspection Summary").Range("E10").Value = "3,000,000"
End If
'Check selected input file format for YesTech AOI Inspection Results format
Const chkYesTech = "[StartIspn]"
For n1 = LBound(OpenFileName) To UBound(OpenFileName)
fn = FreeFile
Open OpenFileName(n1) For Input As #fn
Application.StatusBar = "Processing ... " & OpenFileName(n1)
WholeFile = Input(LOF(fn), #fn)
SplitArray = Split(WholeFile, vbCrLf)
LineNumber = 1
chkFormat1 = SplitArray(LineNumber - 1)
Close #fn
If InStr(1, chkFormat1, chkYesTech, vbBinaryCompare) > 0 Then
MsgBox OpenFileName(n1) & vbNewLine & " has been verified as a YesTech AOI Inspection Results Data File"
' Import user selected YesTech AOI Inspection Results Data File(s) to "Raw Data" worksheet
TargetRow = 0
Set destCell = Worksheets("Raw Data").Range("B1")
For n2 = LBound(OpenFileName) To UBound(OpenFileName)
fn = FreeFile
Open OpenFileName(n2) For Input As #fn
Application.StatusBar = "Processing ... " & OpenFileName(n2)
Do While Not EOF(fn)
Line Input #fn, RawData
If Len(Trim(RawData)) > 0 Then
TargetRow = TargetRow + 1
Worksheets("Raw Data").Range("B" & TargetRow) = RawData
End If
Loop
Next n2
Close #fn
Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlDown).Address)
With rngTarget
.TextToColumns Destination:=destCell, DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, OtherChar:="|", _
FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End With
Else: MsgBox OpenFileName(n1) & vbNewLine & " is not a YesTech AOI Inspection Results Data File."
Exit Sub
End If
Next
' Create a number list (autofill) in Col A to maintain original import sort order
dLastRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Raw Data").Range("A1:A" & dLastRow).Font.Color = RGB(200, 200, 200)
Worksheets("Raw Data").Range("A1") = "1"
Worksheets("Raw Data").Range("A2") = "2"
Worksheets("Raw Data").Range("A1:A2").AutoFill Destination:=Worksheets("Raw Data").Range("A1:A" & dLastRow), Type:=xlFillDefault
Worksheets("Raw Data").Range("F1:Q" & dLastRow).NumberFormat = "0.0"
' List open file name(s) on spreadsheet for user reference
Worksheets("AOI Inspection Summary").Range("E9").Font.Name = "Calibri"
Worksheets("AOI Inspection Summary").Range("E9").Font.Size = 9
Worksheets("AOI Inspection Summary").Range("E9").Font.Bold = True
Worksheets("AOI Inspection Summary").Range("E9").Font.Color = RGB(0, 0, 255)
FileListRow = 0
Set rngFileList = Worksheets("AOI Inspection Summary").Range("E9")
For i = LBound(OpenFileName) To UBound(OpenFileName)
Debug.Print OpenFileName(i)
' Add imported file name or hyperlink to imported files in list of imported files
' rngFileList.Offset(FileListRow, 0) = OpenFileName(i)
rngFileList.Offset(FileListRow, 0).Hyperlinks.Add Anchor:=rngFileList.Offset(FileListRow, 0), _
Address:=OpenFileName(i), _
ScreenTip:="Imported File Number " & FileListRow + 1, _
TextToDisplay:=OpenFileName(i)
rngFileList.Offset(FileListRow, 0).Font.Name = "Calibri"
rngFileList.Offset(FileListRow, 0).Font.Size = 9
rngFileList.Offset(FileListRow, 0).Font.Color = RGB(0, 0, 255)
FileListRow = FileListRow + 1
Next i
' Auto fit the width of columns for RAW Data
Worksheets("Raw Data").Columns("A:Z").EntireColumn.AutoFit
' Timer Stop (calculate the length of time this sub-routine took to complete)
SecondsElapsed = Round(Timer - StartTime, 2)
' Turn screen updating and auto calculating back on since file processing is now complete
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
' Display a message to report the sub-routine processing time after file selection including the number of data rows that have been imported
MsgBox "AOI Inspection Results processed and imported in " & SecondsElapsed & " seconds" & " ." & vbNewLine & _
" Successfully imported " & (TargetRow) & " rows of data.", vbInformation, "Data Import Results"
' Reset to defaults in the event of a processing error during the sub-routine execution
ErrorHandler:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
If Err.Number <> 0 Then
' Display a message to user including error code in the event of an error during execution
MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _
"Part or all of this VBA script was not completed.", vbInformation, "Error Message"
End If
End Sub
非常感谢任何有关更好方法的想法或建议。
答案 0 :(得分：4)
正如我的评论中所提到的，你的帖子中有很多内容。但是，专注于此
我现在尝试将父文件夹定义为变量，允许用户使用Application.InputBox输入子文件夹名称，然后自动从用户指定的子文件夹中的所有.txt文件中导入数据。
我有一个解决方案 - 您可以创建一个存储每个文件（路径和文件名）的数组，您应该可以使用它来获取文件名然后执行任何操作：
Sub import_files()
Dim files As String
Dim parentDir As String
parentDir = InputBox("Please input the directory you want to import files from")
If parentDir = "" Then Exit Sub 'If they hit "Cancel" or don't put anything.
' parentDir = GetFolder() 'UNCOMMENT THIS if you want the user to select a folder via "Windows Explorer"
files = LoopThroughFiles(parentDir, "txt")
' Debug.Print (files)
Dim iFiles() As String
iFiles() = Split(files, ",")
Dim i As Long
For i = LBound(iFiles) To UBound(iFiles)
If iFiles(i) <> "" Then
Debug.Print ("File located: " + parentDir + "\" + iFiles(i))
' THIS IS YOUR ARRAY, `iFILES`, SO HERE IS WHERE YOU DO STUFF
End If
Next i
End Sub
Private Function LoopThroughFiles(inputDirectoryToScanForFile, filenameCriteria) As String
'https://stackoverflow.com/a/45749626/4650297
Dim tmpOut As String
Dim StrFile As String
'Debug.Print "in LoopThroughFiles. inputDirectoryToScanForFile: ", inputDirectoryToScanForFile
StrFile = Dir(inputDirectoryToScanForFile & "\*" & filenameCriteria)
Do While Len(StrFile) > 0
' Debug.Print StrFile
tmpOut = tmpOut + "," + StrFile
StrFile = Dir
Loop
LoopThroughFiles = tmpOut
End Function
Function GetFolder() As String
' https://stackoverflow.com/a/26392703/4650297
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
编辑：我添加了一种让用户通过更多＆＃34;传统＆＃34;选择文件夹的方法。 Windows资源管理器类型窗口，而不是粘贴在路径字符串中。但是，任何一个都应该为你工作，让我知道任何问题。