-1
答案提供了幫助，但我在它中找到了一些問題在文件夾中找到excel文件。我已經使用了一個對話框來允許用戶選擇文件夾來協助這項工作，但這似乎奏效了，但我現在正在收到運行時錯誤438（對象不支持此屬性或方法）。這是從文件夾打開第一個Excel工作簿後發生的（FileToOpen = Workbooks.Open（摺疊））
我在下面提供了我的更新代碼。有關如何修改的想法？
此前後： 我有一些問題更新我的代碼，使我能夠選擇/多重執行的操作Excel表。該代碼本身旨在打開一本excel書籍，將適當的數據複製到'數據庫'中並關閉它。 我想要做的是循環遍歷特定文件夾中的每個工作簿，每次都執行相同的操作，直到所有工作簿都已提取數據。 感謝一些幫助！
代碼如下：
Sub ImportData()
'This sub is designed to pull the data from the respective spreadsheets into the Database
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim sheet As Worksheet
Dim FolderPath As FileDialog
Dim Fold As String
Dim Directory As String
Set wb1 = ActiveWorkbook
Application.ScreenUpdating = True
'select the path to the folder you want
Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker)
With FolderPath
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
Directory = .SelectedItems(1) & "\"
End With
NextCode:
Fold = ""
Fold = Dir(Directory)
Do While Fold <> ""
Application.ScreenUpdating = False
FileToOpen = Workbooks.Open(Fold)
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each sheet In wb1.Sheets
With sheet.UsedRange
Loopy = Range("B1").End(xlDown).Offset(1, 0)
End With
Next sheet
L = wb1.Sheets("Database").Cells(Rows.Count, "B").End(xlUp).Row + 1
'Name
wb2.Sheets("Feedback").Range("D4").Copy
wb1.Sheets("Database").Range("B" & L).PasteSpecial xlPasteValues
'Paper
wb2.Sheets("Feedback").Range("D5").Copy
wb1.Sheets("Database").Range("C" & L).PasteSpecial xlPasteValues
'Date
wb2.Sheets("Feedback").Range("D6").Copy
wb1.Sheets("Database").Range("D" & L).PasteSpecial xlPasteValues
'Completed by
wb2.Sheets("Feedback").Range("D7").Copy
wb1.Sheets("Database").Range("E" & L).PasteSpecial xlPasteValues
'rating
wb2.Sheets("Feedback").Range("J20").Copy
wb1.Sheets("Database").Range("F" & L).PasteSpecial xlPasteValues
'qualifiers
wb2.Sheets("Feedback").Range("C17").Copy
wb1.Sheets("Database").Range("G" & L).PasteSpecial xlPasteValues
wb2.Sheets("Feedback").Range("D17").Copy
wb1.Sheets("Database").Range("H" & L).PasteSpecial xlPasteValues
wb2.Sheets("Feedback").Range("E17").Copy
wb1.Sheets("Database").Range("I" & L).PasteSpecial xlPasteValues
wb2.Sheets("Feedback").Range("F17").Copy
wb1.Sheets("Database").Range("J" & L).PasteSpecial xlPasteValues
wb2.Sheets("Feedback").Range("G17").Copy
wb1.Sheets("Database").Range("K" & L).PasteSpecial xlPasteValues
wb2.Sheets("Feedback").Range("H17").Copy
wb1.Sheets("Database").Range("L" & L).PasteSpecial xlPasteValues
wb2.Sheets("Feedback").Range("I17").Copy
wb1.Sheets("Database").Range("M" & L).PasteSpecial xlPasteValues
wb2.Sheets("Feedback").Range("J17").Copy
wb1.Sheets("Database").Range("N" & L).PasteSpecial xlPasteValues
'comments
wb2.Sheets("Feedback").Range("B18").Copy
wb1.Sheets("Database").Range("O" & L).PasteSpecial xlPasteValues
wb2.Close
Fold = Dir()
Loop
End Sub
我相信「摺疊」需要是一個變種。此外，我沒有看到子過程中任何地方聲明的「FileToOpen」。你檢查過這些嗎？另外，在出現錯誤的行上，「Directory」的值是多少？ – Kyle 2015-02-24 15:12:00
嗨凱爾，再次感謝。我有點殘酷！我已經將摺疊變成了變體，並嘗試將FileToOpen定義爲字符串（儘管我相信以前沒有定義時它可以工作）。目錄是保存excel文件的文件夾路徑:) – Spaceman 2015-02-24 17:50:39
我明白「目錄」是什麼，但是當你的錯誤發生時它保存的字符串是什麼？如果您不知道，請在錯誤之前的行中鍵入「Debug.Print Directory」。這將顯示錯誤發生時存儲在變量「Directory」中的字符串。在我的代碼中沒有任何東西看起來不對，所以我有一種感覺，它與變量有關。 – Kyle 2015-02-24 17:55:43