Using a range to input data to a filename

2019-09-04 10:52发布

Good Afternoon. I have been running into an issue with this code. It works perfectly if I allow the excel workbook to open, and then close it using the ActiveWorkbook.Close function. If I comment the .close function out, I get the runtime error. I would desire all workbooks to open and stay open.

Sub openwb1()
    Dim EPath As String, EFile As String, EMo As String, EVar As String, lastrow As Long, counter As Long, EFound As String

    lastrow = Worksheets("Opener").Cells(Rows.Count, 1).End(xlUp).Row

For counter = 1 To lastrow

    EPath = "Q:\MY PATH\"
    EVar = Worksheets("Opener").Range("A" & counter).Value
    EMo = MonthName(DatePart("m", Now), True) & " " & DatePart("yyyy", Now) & "\"
    EFound = Dir(EPath & EVar & EMo & "*$*.xlsx")

    If EFound <> " " Then
       Workbooks.Open FileName:=EPath & EVar & EMo & "\" & EFound
       End If

    If Len(Dir(EPath & EVar & EMo, vbDirectory)) = 0 Then
        MkDir EPath & EVar & EMo
        End If

    'ActiveWorkbook.Close

Next counter
End Sub

2条回答
狗以群分
2楼-- · 2019-09-04 11:36

Something like this (untested)

Sub openwb1()

    Dim EPath As String, EFile As String, EMo As String
    Dim EVar As String, lastrow As Long, counter As Long, EFound As String
    Dim wb As Workbook

    lastrow = Worksheets("Opener").Cells(Rows.Count, 1).End(xlUp).Row

    'next two lines do not need to be inside the loop
    EPath = "Q:\MY PATH\"
    EMo = MonthName(DatePart("m", Now), True) & " " & DatePart("yyyy", Now) & "\"

    For counter = 1 To lastrow

        EVar = Worksheets("Opener").Range("A" & counter).Value

        If Len(Dir(EPath & EVar & EMo, vbDirectory)) = 0 Then

            MkDir EPath & EVar & EMo

        Else
            'only check for a file if the source folder was found...
            EFound = Dir(EPath & EVar & EMo & "*$*.xlsx")

            If EFound <> "" Then
                Set wb = Workbooks.Open(Filename:=EPath & EVar & EMo & "\" & EFound)

                'do something with wb

                wb.Close False 'don't save changes?

            End If

        End If

    Next counter

End Sub
查看更多
该账号已被封号
3楼-- · 2019-09-04 11:38

Try to change EVar = Worksheets("Opener").Range("A" & counter).Value to EVar = Thisworkbook.Worksheets("Opener").Range("A" & counter).Value.

BTW, lastrow = Worksheets("Opener").Cells(Worksheets("Opener").Rows.Count, 1).End(xlUp).Row could be changed to lastrow = Worksheets("Opener").Cells(Rows.Count, 1).End(xlUp).Row, because every worksheet in this workbook has the same Rows.Count. You do not need to specify which worksheet to count.

查看更多
登录 后发表回答