我有這個宏正在輸入excel,並生成excel報告並複製它。下面的代碼工作正常,當我從msg對話框的Excel手動運行,但是當我試圖傳遞輸入文件的相對路徑時,我得到「運行時錯誤9」 - 子腳本超出範圍。調試器指向Each sh作爲錯誤上下文。當輸入文件的相對路徑包含在腳本錯誤報告-VBA
我該如何解決這個問題?
Sub buildSCTR()
'
' Merge CSV and built pivot for SCTR
' Ver 0.1
' 5-July-2017 P. Coffey
'
Const FILELIMIT = 0 'used to hardcode number of files will work with. better ways exist but this will do for now
Dim firstFilename As String
Dim secondFilename As String
Dim outputFilename As String
Dim element As Variant
Dim dirLocation As String
Dim macroWb As Object
Dim lastrow As Integer
Dim samName As String
Dim RootFolder As String
'code allows for multiple import, but using it for one one import here
Dim filenameArr(0 To FILELIMIT) As Variant 'so can push cells into it later
Dim inputSelected As Variant 'has to variant to iterate over via for each even though its a string
Set macroWb = ThisWorkbook
RootFolder = ActiveWorkbook.Path
'get new csv to load
'Set fd = Application.FileDialog(msoFileDialogFilePicker)
' With fd
' .AllowMultiSelect = True
' .Title = "Pick SC file to load"
'.Filters.Clear
'.Filters.Add "csv", "*.csv*"
'If .Show = True Then
' i = 0
' For Each inputSelected In .SelectedItems
' filenameArr(i) = Dir(inputSelected) 'kludgy....
' dirLocation = Split(inputSelected, filenameArr(i))(0)
' i = i + 1
'Next inputSelected
' Else
' MsgBox ("Nothing selected")
' Exit Sub
' End If
'End With
Application.StatusBar = "Starting to update"
element = RootFolder + "/Output/_SCT_Details_With_Comments.csv"
' For Each element In filenameArr()
If Not IsEmpty(element) Then 'as hardcoded length of array have to do this
Workbooks.Open (element)
Call CopyWorkbook(CStr(element), macroWb.Name)
'close csv as done with it
Workbooks(element).Close SaveChanges:=False
End If
'Next element
'convert to table
samName = ActiveSheet.Range("A2").Value
ActiveSheet.Name = samName & "_SCT_Data"
'assumes col A is contiguous
lastrow = ActiveSheet.Range("A1").End(xlDown).Row
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A1:$U" & lastrow), , xlYes).Name = "SCT"
'build pivot
Dim objWs As Worksheet
Dim objPT As PivotTable
Dim objPC As PivotCache
Sheets.Add.Name = "Summary"
Set objWs = ActiveSheet
Set objPC = ActiveWorkbook.PivotCaches.Create(xlDatabase, "SCT")
Set objPT = objPC.CreatePivotTable(objWs.Range("A3"), TableName:="SCTR")
With ActiveSheet.PivotTables("SCTR").PivotFields("Target_SC")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("SCTR").PivotFields("Action")
.Orientation = xlRowField
End With
ActiveSheet.PivotTables("SCTR").AddDataField ActiveSheet.PivotTables(_
"SCTR").PivotFields("PNI_SC"), "Count of PNI_SC", xlCount
'have to do it in this order else vba was removing pni_sc from row field...who knows why
With ActiveSheet.PivotTables("SCTR").PivotFields("PNI_SC")
.Orientation = xlRowField
.Position = 1
End With
'--update sheet with last sync info
macroWb.Sheets("Summary").Range("A1").Value = samName
macroWb.Sheets("Summary").Range("A3").NumberFormat = "h:mm dd/mm"
'save as new file
Dim timestamp As String
timestamp = Format(Now(), "mmddhh")
ActiveWorkbook.SaveAs Filename:= _
dirLocation & samName & "_SCTR_" & timestamp & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'exit msg
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox ("Completed - saved file as " & dirLocation & samName & "_SCTR_" & timestamp & ".xlsm")
End Sub
Sub CopyWorkbook(source As String, target As String)
'copy all sheets from one workbook to another
Dim sh As Worksheet, wb As Workbook
Set wb = Workbooks(target)
For Each sh In Workbooks(source).Worksheets
sh.Copy After:=wb.Sheets(wb.Sheets.Count)
Next sh
End Sub
工作簿必須先打開「源」和「目標」,然後才能複印工作表。 – h2so4
感謝您的回覆,您可以在踢出副本之前建議腳本或修改我的代碼以開放源代碼和目標。 – Sam
@ sam,在仔細閱讀代碼後,它看起來像兩個工作簿都是開放的。 – h2so4