我目前將資料表匯入到我從 CAD 匯出的 Excel 中。這包括摘要、計數和其他資料。我想添加到代碼中，以便它從預定目錄匯入檔案C:\Jobs\packlist并使用單元格內的數字='PL CALC'!B1（這將確定檔案名）。想法是洗掉打開的對話框并增加自動化。
這是我迄今為止發現的有效方法。它打開選定的檔案并將其復制到作業簿 18 之后的作業簿中。
'import excel data sheet
Sub import()
Dim fName As String, wb As Workbook
'where to look for the framecad excel file
ChDrive "C:"
ChDir "C:\Jobs\packlist"
fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
For Each sh In wb.Sheets
Sheets.Copy After:=ThisWorkbook.Sheets(18)
Exit For
Next
wb.Close False
Worksheets("PL CALC").Activate
End Sub
uj5u.com熱心網友回復：
匯入表
Option Explicit
Sub ImportSheets()
Const ProcTitle As String = "Import Sheets"
Const sFolderPath As String = "C:\Jobs\packlist\"
Const sfnAddress As String = "B1"
Const sFileExtensionPattern As String = ".xls*"
Const dwsName As String = "PL CALC"
Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
Dim dws As Worksheet: Set dws = dwb.Worksheets(dwsName)
Dim sFilePattern As String: sFilePattern = sFolderPath & "*" _
& dws.Range(sfnAddress).Value & sFileExtensionPattern
Dim sFileName As String: sFileName = Dir(sFilePattern)
If Len(sFileName) = 0 Then
MsgBox "No file found..." & vbLf & "'" & sFilePattern & "'", _
vbCritical, ProcTitle
Exit Sub
End If
Application.ScreenUpdating = False
Dim swb As Workbook: Set swb = Workbooks.Open(sFolderPath & sFileName)
Dim sh As Object
For Each sh In swb.Sheets
sh.Copy After:=dwb.Sheets(dwb.Sheets.Count)
Next sh
swb.Close SaveChanges:=False
dws.Activate
'dwb.Save
Application.ScreenUpdating = True
MsgBox "Sheets imported.", vbInformation, ProcTitle
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/364557.html
下一篇：VBA中數字序列的正確代碼是什么