运行时错误1004 while workbook.open方法

Question

Public Sub test() 

Dim wbk As Workbook 
Dim Conswbk As Workbook 
Dim Temppath As String 
Dim PayTemp As String 
Dim Path As String 
Dim lstactrow As String 

Path = "C:\Users\mathew.m.1\Desktop\New folder\" 

Application.DisplayAlerts = False 

Set Conswbk = ThisWorkbook 

Conswbk.Worksheets("Consolidate Payments").Activate 

Cells.ClearContents 

Cells.ClearFormats 



PayTemp = Dir(Path & "*.*") 

'-------------------------------------------- 
'OPEN EXCEL FILES 


Do While PayTemp > "" 'IF NEXT FILE EXISTS THEN 


    Set wbk = Workbooks.Open(Path & PayTemp) 
    ' 
    Range("A12:M1000").Select 
    Selection.Copy 
    Conswbk.Worksheets("Consolidate Payments").Activate 
    lstactrow = Conswbk.Worksheets("Consolidate Payments").Cells(Rows.Count, "C").End(xlUp).Row 
    Range("B" & lstactrow).Select 
    ActiveCell.Offset(1, 0).Select 
    ActiveCell.PasteSpecial (xlPasteAll) 

    Conswbk.Worksheets("Consolidate Payments").Range("A" & lstactrow).Select 
    Selection.Offset(1, 0).Select 
    ActiveCell.Value = PayTemp 

    wbk.Close True 
    Set wbk = Nothing 

    PayTemp = Dir 
Loop 

MsgBox ("Done!!!") 

End Sub 

第一次打开工作簿。但是，在第二次循环之后它不会。需要帮忙。

Answer 1

这将摆脱Active*和.select引用，所以你不担心哪个工作表/工作簿是哪个。注意关于行/列顺序的注释，我永远不会记得我头顶的第一个 - 你可能不得不切换它们。

Public Sub test() 

Dim wbk As Workbook 
Dim Conswbk As Workbook 
Dim ConsWS as Worksheet 
Dim Temppath As String 
Dim PayTemp As String 
Dim Path As String 
Dim lstactrow As String 

Path = "C:\Users\mathew.m.1\Desktop\New folder\" 
'Application.DisplayAlerts = False 
Set Conswbk = ThisWorkbook 
Set ConsWS = Conswbk.Worksheets("Consolidate Payments") 
ConsWS.UsedRange.Cells.ClearContents 
ConsWS.UsedRange.Cells.ClearFormats 

PayTemp = Dir(Path & ".") 

'-------------------------------------------- 'OPEN EXCEL FILES 
Do While PayTemp > "" 'IF NEXT FILE EXISTS THEN 
    Set wbk = Workbooks.Open(Path & PayTemp) 
    wbk.Range("A12:M1000").copy 
    'Range("A12:M1000").Select 
    'Selection.Copy 
    'Conswbk.Worksheets("Consolidate Payments").Activate 
    lstactrow = ConsWS.Cells(Rows.Count, "C").End(xlUp).Row 
    Consws.cells(2,lstactrow+1).paste 'note, may have row/col switched, can never remember 
    'Range("B" & lstactrow).Select 
    'ActiveCell.Offset(1, 0).Select 
    'ActiveCell.PasteSpecial (xlPasteAll) 
    consWB.cells(1,lstactrow+1) = PayTemp 
    'Conswbk.Worksheets("Consolidate Payments").Range("A" & lstactrow).Select 
    'Selection.Offset(1, 0).Select 
    'ActiveCell.Value = PayTemp 

    wbk.Close True 
    Set wbk = Nothing 

    PayTemp = Dir 

Loop 

MsgBox ("Done!!!") 
set consws = nothing 
set conswbk = nothing 

End Sub