Question

我有这个宏，它正在输入excel，并生成excel报告并复制它。当我从带有msg对话框的excel手动运行时，下面的代码工作正常，但是当我试图传递输入文件的相对路径时，我得到“运行时错误9”-Subscript超出范围。而调试器指向每个sh作为错误上下文。

我该如何解决这个问题？

 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

Answer 1

问题是由于源包含工作簿的完整名称（包含路径）而Excel只需要工作簿的短名称（没有路径）

这样调整调用指令

Call CopyWorkbook(ActiveWorkbook.Name, macroWb.Name)

当输入文件的相对路径包含在脚本错误报告-VBA中时

1 个答案: