mkDir Runtime 76 Error Handler

C

Challis

New Member
Joined
Oct 22, 2017
Messages
21
Hello
Sorry for the long code, I need some assistance.
The mkdir function creates a folder based on "Fpath" which is constant and 'Fvariable" which changes basis user form entries if it does not exist. Basically, in the userform, the user enters a series of equipment numbers that define fpath within a folder directory. The final folder [" & "WO" & wsRegister.Cells(btmrow, 3).Text] is created if it does not already exist.
However, if user mucks up the userform entry, a runtime 76 error error occurs as the directory for preceding folders is incorrect. How can i create an error handler for this so instead of getting runtime 76 error, users get a text box saying something along the lines of "You have incorrectly entered equipment information. Please check and try again."
Thanks for your help and again sorry for the long code
Code: 
Private Sub GenerateReport_Click()
Dim wsRegister As Worksheet
Dim wsLookUp As Worksheet
Dim wsCorrelation As Worksheet
Dim btmrow As Integer
Dim fpathtemplateExcel As String
Dim fnametemplateExcel As String
Dim fpathtemplateWord As String
Dim fnametemplateWord As String
Dim FileDirectory As String


    Set wsRegister = ThisWorkbook.Sheets(Register)
    Set wsLookUp = ThisWorkbook.Sheets(Lookup)
    Set wsCorrelation = ThisWorkbook.Sheets(Correlation)
    Dim Fpath As String
    Dim FVariable As String
    Dim Fname As String
    Dim Ans As String
    Dim objWord As Object
    Dim objdoc As Object
    Dim NoFolder As String


    Application.ScreenUpdating = False ' Improves speed
    On Error GoTo ErrorHandler


    'Find and define btmrow (bottom row)
    btmrow = wsRegister.Cells(wsRegister.Rows.Count, "A").End(xlUp).Row


    'Statement for jobs that shall not produce a new file
    Select Case wsRegister.Cells(btmrow, 8).Value
        Case Is = "COMPLIANCE": MsgBox ("No file generated for compliance NDT")
            Exit Sub
        Case Is = "SCOPE": MsgBox ("No file generated for scoping documents")
            Exit Sub
        Case Is = "VENDOR": MsgBox ("No file generated for vendor documents")
            Exit Sub
        Case Is = "NDT": Ans = MsgBox("No file generated for NDT documents")
        'To create and save the inspection report file
        Case Is = "INSPECTION": Ans = MsgBox("A report will be generated from the last data entry." & vbCr & vbCr & _
                                      "Do you wish to proceed?", vbYesNo, "Confirm") 'then generate a report
                        If Ans = vbNo Then Exit Sub    'then create an inspection file
            '1) Define FPath, this is remains constant
            Fpath = "\\BWISHARE1\SHARE\ABU MATERIALS AND INSPECTION ENGINEERING\GORGON\EQUIPMENT INDEX\GGP"
            '2) Define FVariable for various subfolders
            Select Case wsRegister.Cells(btmrow, 5).Value
                Case Is = "PIPELINE": FVariable = "PIPELINE" & "\" & "WO" & wsRegister.Cells(btmrow, 3).Text
                Case Is = "NT": FVariable = "Non-Tagged Equipment" & "\" & "WO" & wsRegister.Cells(btmrow, 3).Value
                Case Is = "Structural": FVariable = "Structural" & "\" & "WO" & wsRegister.Cells(btmrow, 3).Value
                Case Else: FVariable = "GGP-" & wsRegister.Cells(btmrow, 5).Text & "\" & "GGP-" & wsRegister.Cells(btmrow, 5).Text & "-" & wsRegister.Cells(btmrow, 6).Text & "\" & wsRegister.Cells(btmrow, 7).Text & "\Inspections\Data" & "\" & "WO" & wsRegister.Cells(btmrow, 3).Text
                    
                    '3) Define Fname
                    Fname = wsRegister.Cells(btmrow, 10).Text
                    'Create a new folder if it does not already exist.
                     FileDirectory = (Fpath & "\" & FVariable & "\")
                     If Dir(FileDirectory, vbDirectory) <> "" Then 'directory exists
                    Ans = MsgBox("The folder path " & Fpath & " \ " & FVariable & " already exists" & vbCr & vbCr & _
                                 "Do you wish to proceed and create a report?", vbYesNo, "Confirm")
                        If Ans = vbNo Then Exit Sub
                    Else
                    Ans = MsgBox("The folder" & Fpath & " \ " & FVariable & " does not exist" & vbCr & vbCr & _
                                 "Do you wish to create a the folder?", vbYesNo, "Confirm")
                    On Error GoTo ErrorHandler
                    MkDir Trim(Fpath & "\" & FVariable)    'Creates the folder
                    If Ans = vbNo Then Exit Sub
                    End If
                End Select
              


            'To create and save the inspection report file
            Select Case Mid(wsRegister.Cells(btmrow, 7), 10, 2)
                Case Is = "DL":
                Ans = MsgBox("Does your report require an appendix?", vbYesNo)
                Select Case Ans
                    Case vbNo
                    fpathtemplateWord = Application.VLookup((Mid(wsRegister.Cells(btmrow, 7), 10, 2) & wsRegister.Cells(btmrow, 9)), Range("tableCorrelation"), 2, False)
                    fnametemplateWord = Application.VLookup((Mid(wsRegister.Cells(btmrow, 7), 10, 2) & wsRegister.Cells(btmrow, 9)), Range("tableCorrelation"), 3, False)
                    Case vbYes
                    fpathtemplateWord = Application.VLookup((Mid(wsRegister.Cells(btmrow, 7), 10, 2) & wsRegister.Cells(btmrow, 9)) & "A", Range("tableCorrelation"), 2, False)
                    fnametemplateWord = Application.VLookup((Mid(wsRegister.Cells(btmrow, 7), 10, 2) & wsRegister.Cells(btmrow, 9)) & "A", Range("tableCorrelation"), 3, False)
                    End Select
                    'Activate word
                    Set objWord = CreateObject("Word.Application")
                    Set objdoc = objWord.documents.Add
                    objWord.Visible = True
                    objWord.documents.Open Filename:=fpathtemplateWord & "\" & fnametemplateWord
                    With objWord.activedocument
                        .Bookmarks("Date").Range.Text = wsRegister.Cells(btmrow, 11).Text
                        .Bookmarks("ReportNumber").Range.Text = wsRegister.Cells(btmrow, 10).Text
                        .Bookmarks("DamageLoop").Range.Text = wsRegister.Cells(btmrow, 7).Text
                        .Bookmarks("Unit").Range.Text = wsRegister.Cells(btmrow, 6).Text
                        .Bookmarks("Location").Range.Text = wsRegister.Cells(btmrow, 5).Text
                        .Bookmarks("WorkOrder").Range.Text = wsRegister.Cells(btmrow, 3).Text
                        .Bookmarks("Person").Range.Text = wsRegister.Cells(btmrow, 12).Text
                    End With
                    objWord.activedocument.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
                    Set objWord = Nothing


                Case Else:
                    Ans = MsgBox("Does your report require an appendix?", vbYesNo)
                    Select Case Ans
                    Case vbNo
                    fpathtemplateWord = Application.VLookup("V" & wsRegister.Cells(btmrow, 9), Range("tableCorrelation"), 2, False)
                    fnametemplateWord = Application.VLookup("V" & wsRegister.Cells(btmrow, 9), Range("tableCorrelation"), 3, False)
                    Case vbYes
                    fpathtemplateWord = Application.VLookup("V" & wsRegister.Cells(btmrow, 9) & "A", Range("tableCorrelation"), 2, False)
                    fnametemplateWord = Application.VLookup("V" & wsRegister.Cells(btmrow, 9) & "A", Range("tableCorrelation"), 3, False)
                    End Select
                    'Activate word
                    Set objWord = CreateObject("Word.Application")
                    Set objdoc = objWord.documents.Add
                    objWord.Visible = True
                    objWord.documents.Open Filename:=fpathtemplateWord & "\" & fnametemplateWord
                    With objWord.activedocument
                        .Bookmarks("Date").Range.Text = wsRegister.Cells(btmrow, 11).Text
                        .Bookmarks("ReportNumber").Range.Text = wsRegister.Cells(btmrow, 10).Text
                        .Bookmarks("EquipmentNumber").Range.Text = wsRegister.Cells(btmrow, 7).Text
                        .Bookmarks("Unit").Range.Text = wsRegister.Cells(btmrow, 6).Text
                        .Bookmarks("Location").Range.Text = wsRegister.Cells(btmrow, 5).Text
                        .Bookmarks("WorkOrder").Range.Text = wsRegister.Cells(btmrow, 3).Text
                        .Bookmarks("Person").Range.Text = wsRegister.Cells(btmrow, 12).Text
                    End With
                    objWord.activedocument.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
                    Set objWord = Nothing
            End Select
    End Select
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Unload Me
    Exit Sub
ErrorHandler:
    Select Case Err.Number
    Case Else
        MsgBox ("An error has occured which hasn't been coded for. " & Err.Number & " - " & Err.Description)
    End Select
End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Try this and see if it works,

Code: 
'Your code goes in here
'
ErrorHandler:
    Select Case Err.Number
    Case 76
        MsgBox "You have incorrectly entered equipment information. Please check and try again.", vbCritical
    Case Else
        MsgBox ("An error has occured which hasn't been coded for. " & Err.Number & " - " & Err.Description)
    End Select
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Nested Case Statement Case Else Outside Select Case
Replies
4
Views
757
NARAYANK991
N
C
  • Question Question
Open Word Window in VBA
Replies
1
Views
701
NdNoviceHlp
NdNoviceHlp
B
  • Question Question
Excel VBA inconsistent errors when trying to copy and paste objects from Excel to Word
2
Replies
18
Views
37K
Jon Peltier
J
C
  • Question Question
VBA Excel I run a group of macros and need to have an error handler for one of the macros
Replies
4
Views
749
Yongle
Yongle
S
  • Question Question
enter vba code
Replies
1
Views
564
Fluff
Fluff

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top