error handling for files that are already open

[rholdren]

Good Morning

I have a macro (Excel 365) that opens a file on sheet1 in column A Row 1 copies data then opens a file in column B row 1 pastes the data then saves the file then moves down to row 2 and does the same then to row 3 etc....etc.. (Thanks Joe4) What I can't figure out is the error handling. What I would like to do is let's say all is fine until I get down to a file in column B that someone has open. I won't be able to paste and save because I'll get the "A file named..... is already open" error. What I would like is to have the code place the name of that file in column A of sheet2 and then move on to the next file without me having to intervene. Any help on this would be greatly appreciated.

Sheet1

Sheet2

 

[rlv01]

Here is some reading on error handling.

Error Handling In VBA

 

[rholdren]

While that has some things in there that I found useful and I have read it before. What I need is the portion of code that says on this error copy the file name and paste in on sheet2 in column A. Once there I can us a Do If IsEmpty to ensure it doesn't copy over a file that may have been recorded previously. What I am looking for is just a small piece of code that says if this error occurs copy the file name and place it here the resume next. I've tried a few things but I just can't seem to find the correct wording.

 

[dmt32]

What I am looking for is just a small piece of code that says if this error occurs copy the file name and place it here the resume next. I've tried a few things but I just can't seem to find the correct wording.

Suggest share the code you need modifying & maybe those on Forum can assist you further.

Dave

 

[rholdren]

Private Sub Move_Data()
'
' POST_FILE_1 Macro
' COPY DATA FROM TEST FILE 1 TO RECIVE FILE 1 SAVE AND CLOSE FILE
'
'
Application.ScreenUpdating = False


Dim columnX As Range, cell As Range
Set columnX = Range("A2:A2")
Dim path1, path2 As String

For Each cell In columnX


ChDir "S:\ReportingDepartment\ReportingAnalyst\Projects\REX\Original Report Data"
path1 = cell.Value
Workbooks.Open Filename:=path1


Range("A2:M13").Select
Selection.Copy

Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True

ChDir "S:\ReportingDepartment\ReportingAnalyst\Projects\REX\Reports To Be Sent"

'copies the vaule of the offset to thr right cell into path2
path2 = cell.Offset(0, 1).Value
Workbooks.Open Filename:=path2

Sheets("Detail").Select
Range("A5:M16").Select
Application.DisplayAlerts = False
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
DisplayAsIcon:=False, NoHTMLFormatting:=True
Application.DisplayAlerts = True
Range("B5:B17").Select
Selection.NumberFormat = "0"
Columns("B:B").EntireColumn.AutoFit
Range("A3").Select
Sheets("Summary").Select
ActiveWorkbook.Save
ActiveWindow.Close

Next cell

Range("D5").Value = "Process Complete"

End Sub

 

[rlv01]

What I am looking for is just a small piece of code that says if this error occurs copy the file name and place it here the resume next. I've tried a few things but I just can't seem to find the correct wording.

You want to watch for a certain error, then do things if the error occurs. The general template for what you want to do looks like this.

Sub MyCode()
    
    On Error GoTo ErrHandler:
    '
    ' Your main code goes here.
    '
    '
    Exit Sub
    
ErrHandler:
    If Err.Number = 9 Then       'error 9 is an example. Change it to fit your needs.
        '
        ' Your code for actions you want to take when error 9 (or whatever) occurs goes here.
        '
        '
        Resume Next                   ' go back to the line following the error
    Else
        MsgBox "Runtime Error " & Err.Number & " - " & Err.Description, vbCritical, "Error"
    End If
End Sub

 

[rholdren]

You want to watch for a certain error, then do things if the error occurs. The general template for what you want to do looks like this.

Sub MyCode()
   
    On Error GoTo ErrHandler:
    '
    ' Your main code goes here.
    '
    '
    Exit Sub
   
ErrHandler:
    If Err.Number = 9 Then       'error 9 is an example. Change it to fit your needs.
        '
        ' Your code for actions you want to take when error 9 (or whatever) occurs goes here.
        '
        '
        Resume Next                   ' go back to the line following the error
    Else
        MsgBox "Runtime Error " & Err.Number & " - " & Err.Description, vbCritical, "Error"
    End If
End Sub

Thanks riv01 I'll give it a try on Monday. Leaving work for the day (doc appointment)

 

[GWteB]

Another approach could be not to wait for an error to occur when opening a workbook, but to check whether the workbook has already been opened by another user.
The function below can be used for this. This function also returns a FALSE if the file is missing, so it must be determined beforehand whether the workbook in question exists.

Public Function IsWorkbookOpen(ByVal argFullName As String) As Boolean
    Dim FileNum As Long, ErrNum As Long
    FileNum = VBA.FreeFile()
    On Error Resume Next
    Open argFullName For Input Lock Read As #FileNum
    ErrNum = VBA.Err.Number
    Close FileNum
    IsWorkbookOpen = VBA.CBool(ErrNum)
End Function


Public Sub UsageExample()

    Const SOMEWORKBOOK As String = "C:\Users\rholdren\Workbooks\someworkbook.xlsx"

    If VBA.CreateObject("Scripting.FileSystemObject").FileExists(SOMEWORKBOOK) Then
        If Not IsWorkbookOpen(SOMEWORKBOOK) Then
            ' workbook not in use, do stuff
        Else
            ' workbook is in use, skip this file
        End If
    End If
End Sub

 

[rholdren]

GWteB - Another approach could be not to wait for an error to occur when opening a workbook, but to check whether the workbook has already been opened by another user.
The function below can be used for this. This function also returns a FALSE if the file is missing, so it must be determined beforehand whether the workbook in question exists.

Public Function IsWorkbookOpen(ByVal argFullName As String) As Boolean
    Dim FileNum As Long, ErrNum As Long
    FileNum = VBA.FreeFile()
    On Error Resume Next
    Open argFullName For Input Lock Read As #FileNum
    ErrNum = VBA.Err.Number
    Close FileNum
    IsWorkbookOpen = VBA.CBool(ErrNum)
End Function


Public Sub UsageExample()

    Const SOMEWORKBOOK As String = "C:\Users\rholdren\Workbooks\someworkbook.xlsx"

    If VBA.CreateObject("Scripting.FileSystemObject").FileExists(SOMEWORKBOOK) Then
        If Not IsWorkbookOpen(SOMEWORKBOOK) Then
            ' workbook not in use, do stuff
        Else
            ' workbook is in use, skip this file
        End If
    End If
End Sub

GWteB I like where you are going with this thank you for the input. I'll give this a shot and get back to you.

 

[rholdren]

Hi all, this works with one exception. I can't get it to copy the file name that had the issue and paste it in R2. It will move past the open file listed and go to the next file just fine. I'm only using two rows at this time (A2:A3) just for speeding up the process. This is my first venture going into any kind of error handling.

Sub MyCode()

On Error GoTo errHandler:
'
Application.ScreenUpdating = False
'
Dim columnX As Range, cell As Range
Set columnX = Range("A2:A3")
Dim path1, path2 As String

For Each cell In columnX


'ChDir "H:\Personal\STOP LOSS\UMR Files\Original Report Data"
ChDir "S:\ReportingDepartment\ReportingAnalyst\Projects\REX\Original Report Data"

'copies current cell value into path1
path1 = cell.Value
Workbooks.Open Filename:=path1

Range("A2:M13").Select
Selection.Copy

Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True

'ChDir "H:\Personal\STOP LOSS\UMR Files\Reports To Be Sent"
ChDir "S:\ReportingDepartment\ReportingAnalyst\Projects\REX\Reports To Be Sent"

'copies the vaule of the offset to thr right cell into path2
path2 = cell.Offset(0, 1).Value
Workbooks.Open Filename:=path2

Sheets("Detail").Select
Range("A5:M16").Select
Application.DisplayAlerts = False
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
DisplayAsIcon:=False, NoHTMLFormatting:=True
Application.DisplayAlerts = True
Range("B5:B17").Select
Selection.NumberFormat = "0"
Columns("B:B").EntireColumn.AutoFit
Range("A3").Select
Sheets("Summary").Select
ActiveWorkbook.Save


ActiveWindow.Close

Next cell
'
'
Exit Sub

errHandler:
If Err.Number = 1004 Then 'error 9 is an example. Change it to fit your needs.
'
Application.DisplayAlerts = False

ActiveCell.Copy

'Sheets("Sheet2").Select
Range("R2").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.PasteSpecial Paste:=xlPasteValues
Resume Next
End If


'Sheets("Sheet1").Select
Range("D5").Value = "Process Complete"

End Sub