Nested Case Statement Case Else Outside Select Case

C

Challis

New Member
Joined
Oct 22, 2017
Messages
21
Hi,
I apologise for the long code but i am completely stuck. I keep getting a Compile Error: Case Else Outside Select Case @ the final Case Else statement. I've been mucking around with the code for 2 hours and i cannot remedy, Please help

Code: 
''Routine to generate a file and folder
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 FileID 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


'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" 'then generate an NDT voucher
    '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.
            If Len(Dir(Fpath & "\" & FVariable)) = 0 Then
            'Directory does not exist, it must be created
            MkDir Trim(Fpath & "\" & FVariable) 'Creates the folder
            End If
            Ans = MsgBox("A new folder created has been created in" & Fpath & " \ " & FVariable & vbCr & vbCr & _
            "Do you wish to proceed and create a voucher?", vbYesNo, "Confirm")
            If Ans = vbNo Then Exit Sub
            'To create and save the NDT report file
            fpathtemplateExcel = Application.VLookup(wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 2, False)
            fnametemplateExcel = Application.VLookup(wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 3, False)
            Workbooks.Open Filename:=fpathtemplateExcel & "\" & fnametemplateExcel
            ActiveWorkbook.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
    End Select
    'To create and save the inspection report file
    Case Is = "INSPECTION" '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.
            If Len(Dir(Fpath & "\" & FVariable)) = 0 Then 'the directory does not exist, it must be created:
            Ans = MsgBox("A new folder created has been created in" & Fpath & " \ " & FVariable & vbCr & vbCr & _
            "Do you wish to proceed and create a report?", vbYesNo, "Confirm")
                If Ans = vbNo Then Exit Sub
            End If
            MkDir Trim(Fpath & "\" & FVariable) 'Creates the folder
    End Select
            
    'To create and save the inspection report file
    Select Case Mid(wsRegister.Cells(Btmrow, 7), 10, 2)
        Case Is = "DL":
        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)
        '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
        objWord.activedocument.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
        Set objWord = Nothing
        
        Case Else:
        fpathtemplateWord = Application.VLookup("V" & wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 2, False)
        fnametemplateWord = Application.VLookup("V" & wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 3, False)
        Debug.Print fpathtemplateWord & "\" & fnametemplateWord
        'Activate word
        Set objWord = CreateObject("Word.Application")
        Set objdoc = objWord.documents.Add
        objWord.Visible = True
        objWord.documents.Open Filename:=fpathtemplateWord & "\" & fnametemplateWord
        withobjword.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
        objWord.activedocument.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
        Set objWord = Nothing
    End Select
End Select
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
You are missing a couple of End Withs, try this.
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 FileID 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


    '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"    'then generate an NDT voucher
            '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.
                    If Len(Dir(Fpath & "\" & FVariable)) = 0 Then
                        'Directory does not exist, it must be created
                        MkDir Trim(Fpath & "\" & FVariable)    'Creates the folder
                    End If
                    Ans = MsgBox("A new folder created has been created in" & Fpath & " \ " & FVariable & vbCr & vbCr & _
                                 "Do you wish to proceed and create a voucher?", vbYesNo, "Confirm")
                    If Ans = vbNo Then Exit Sub
                    'To create and save the NDT report file
                    fpathtemplateExcel = Application.VLookup(wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 2, False)
                    fnametemplateExcel = Application.VLookup(wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 3, False)
                    Workbooks.Open Filename:=fpathtemplateExcel & "\" & fnametemplateExcel
                    ActiveWorkbook.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
            End Select
            'To create and save the inspection report file
        Case Is = "INSPECTION"    '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.
                    If Len(Dir(Fpath & "\" & FVariable)) = 0 Then    'the directory does not exist, it must be created:
                        Ans = MsgBox("A new folder created has been created in" & Fpath & " \ " & FVariable & vbCr & vbCr & _
                                     "Do you wish to proceed and create a report?", vbYesNo, "Confirm")
                        If Ans = vbNo Then Exit Sub
                    End If
                    MkDir Trim(Fpath & "\" & FVariable)    'Creates the folder
            End Select

            'To create and save the inspection report file
            Select Case Mid(wsRegister.Cells(Btmrow, 7), 10, 2)
                Case Is = "DL":
                    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)
                    '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:
                    fpathtemplateWord = Application.VLookup("V" & wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 2, False)
                    fnametemplateWord = Application.VLookup("V" & wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 3, False)
                    Debug.Print fpathtemplateWord & "\" & fnametemplateWord
                    '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
End Sub
 
Upvote 0
Challis said:
Hi,
I apologise for the long code but i am completely stuck. I keep getting a Compile Error: Case Else Outside Select Case @ the final Case Else statement. I've been mucking around with the code for 2 hours and i cannot remedy, Please help

Rich (BB code): 
''Routine to generate a file and folder
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 FileID 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


'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" 'then generate an NDT voucher
    '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.
            If Len(Dir(Fpath & "\" & FVariable)) = 0 Then
            'Directory does not exist, it must be created
            MkDir Trim(Fpath & "\" & FVariable) 'Creates the folder
            End If
            Ans = MsgBox("A new folder created has been created in" & Fpath & " \ " & FVariable & vbCr & vbCr & _
            "Do you wish to proceed and create a voucher?", vbYesNo, "Confirm")
            If Ans = vbNo Then Exit Sub
            'To create and save the NDT report file
            fpathtemplateExcel = Application.VLookup(wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 2, False)
            fnametemplateExcel = Application.VLookup(wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 3, False)
            Workbooks.Open Filename:=fpathtemplateExcel & "\" & fnametemplateExcel
            ActiveWorkbook.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
    End Select
    'To create and save the inspection report file
    Case Is = "INSPECTION" '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.
            If Len(Dir(Fpath & "\" & FVariable)) = 0 Then 'the directory does not exist, it must be created:
            Ans = MsgBox("A new folder created has been created in" & Fpath & " \ " & FVariable & vbCr & vbCr & _
            "Do you wish to proceed and create a report?", vbYesNo, "Confirm")
                If Ans = vbNo Then Exit Sub
            End If
            MkDir Trim(Fpath & "\" & FVariable) 'Creates the folder
    End Select
            
    'To create and save the inspection report file
    Select Case Mid(wsRegister.Cells(Btmrow, 7), 10, 2)
        Case Is = "DL":
        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)
        '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
        objWord.activedocument.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
        Set objWord = Nothing
        
        Case Else:
        fpathtemplateWord = Application.VLookup("V" & wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 2, False)
        fnametemplateWord = Application.VLookup("V" & wsRegister.Cells(Btmrow, 9), Range("tableCorrelation"), 3, False)
        Debug.Print fpathtemplateWord & "\" & fnametemplateWord
        'Activate word
        Set objWord = CreateObject("Word.Application")
        Set objdoc = objWord.documents.Add
        objWord.Visible = True
        objWord.documents.Open Filename:=fpathtemplateWord & "\" & fnametemplateWord
        withobjword.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
        objWord.activedocument.SaveAs Filename:=Fpath & "\" & FVariable & "\" & Fname
        Set objWord = Nothing
    End Select
End Select
End Sub
Click to expand...
Your indenting scheme make it very, very difficult to debug your code... you should consider using a more normal indenting scheme (indent all code within all block structures such as If..Then, For..Next, With..End With, etc. Your actual problem is that you have a With statement (highlighted in red above, but you will probable have to scroll to see that) but do not have the companion End With statement for it in order to close of the block structure it started.
 
Upvote 0
Thanks guys,
Whilst I've got you,
Any suggestions on how i can fix my create new folder code? I have been mucking around with it, i get an error as the code says the folder does not exist in the case when it does. I then therefore get a path/file access error when it tries to make the folder.
Code: 
If Dir(Fpath & "\" & FVariable) <> "" Then 'directory exists
                    Debug.Print Dir(Fpath & "\" & FVariable)
                    Ans = MsgBox("The folder path " & Fpath & " \ " & FVariable & " already exists" & vbCr & vbCr & _
                                 "Do you wish to proceed and create a voucher?", 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")
                    MkDir Trim(Fpath & "\" & FVariable)    'Creates the folder
                    If Ans = vbNo Then Exit Sub
                    End If
 
Upvote 0
Hi ,

This can happen if your folder has sub-folders , and your complete path , which is :

Fpath & "" & FVariable

does not end with a backslash.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
mkDir Runtime 76 Error Handler
Replies
1
Views
1K
Haluk
H
C
  • Question Question
Open Word Window in VBA
Replies
1
Views
676
NdNoviceHlp
NdNoviceHlp
C
  • Question Question
Saving word document from excel
Replies
1
Views
587
Fluff
Fluff

Forum statistics

Threads
1,223,910
Messages
6,175,320
Members
452,635
Latest member
laura12345

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