X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Error Handler, Access 2016    
post Aug 13 2019, 09:18 AM

Posts: 61
Joined: 7-January 11

So I was able to modify some code I found on the internet to do what I need it to: 1) open all workbooks in a folder, 2) copy a spreadsheet from a master workbook into these workbooks, and 3) finally save/close the file (all while taking into account if the workbook has a password) .

Problem is that within the 500 workbooks that its going through, someone put in a weird password. I then attempted to put in an error handler to give me a msgbox of the name of the workbook but I cant seem to get it working correctly. Please see the below code and let me know what I am missing (I've probably just been staring at it for too long and forgot something stupid).

It Error's out on the
With xl.Workbooks.Open
line within the below code. Thanks in advance.

Sub Command0_Click()
Dim xl As Excel.Application
Dim wbMaster As Excel.Workbook
Set xl = New Excel.Application
Set wbMaster = xl.Workbooks.Open(CurrentProject.path & "\ProjectBabelfish")

Dim wsCopy As Excel.Worksheet
Set wsCopy = wbMaster.Worksheets("Babelfish")

Dim sFolderPath As String
sFolderPath = wbMaster.path & "\PLOGs\"
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"

Dim sFileName As String
sFileName = Dir(sFolderPath & "*.xlsx")

'Disable screenupdating (to prevent "screen flickering" so macro runs smoother)
'Disable alerts (to suppress "Are you sure?" prompts during worksheet deletion)
xl.ScreenUpdating = False
xl.DisplayAlerts = False

'Begin loop through files in the folder
Do While Len(sFileName) > 0

    Dim sWBOpenPassword As String
    Dim sWBProtectPassword As String
    Select Case sFileName
        'Specify workbook names that require passwords here
        Case "book1.xlsx"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

        'If different books require different passwords, can specify additional names with their unique passwords
        Case "Book3.xlsx"
            sWBOpenPassword = "book3openpassword"
            sWBProtectPassword = "book3protectionpassword"

        'Keep specifying excel file names and their passwords until completed
        Case "Book10.xlsx", "Book257.xlsx"
            sWBOpenPassword = "GenericOpenPW2"
            sWBProtectPassword = "GenericProtectPW2"

        'Case Else will handle the remaining workbooks that don't require passwords
        Case Else
            'MsgBox sFileName & " has a wierd password"
            sWBOpenPassword = "550"
            sWBProtectPassword = "550"

    End Select

    'Open file using password (if any)
    With xl.Workbooks.Open(sFolderPath & sFileName, UpdateLinks:=False, Password:=sWBOpenPassword)
        If Err.Number = 1004 Then MsgBox "The workbook " & sFileName & " is at a middle school dance."
        Dim bProtectedWB As Boolean
        bProtectedWB = False    'Reset protected wb check to false

        'Check if workbook is protected and if so unprotect it using the specified protection password
        If .ProtectStructure = True Then bProtectedWB = True
        If bProtectedWB = True Then .Unprotect sWBProtectPassword
            .Sheets(1).Name = "Whole Foods Market PLOG"
        On Error Resume Next    'Suppress error if copied worksheet does not yet exist
        .Worksheets(wsCopy.Name).Delete 'Delete existing sheet if it exists
        On Error GoTo 0         'Remove "On Error Resume Next" condition
            wsCopy.Copy After:=.Worksheets(.Worksheets.Count)   'Copy template into the workbook
            .Worksheets(wsCopy.Name).Cells.Replace wbMaster.Name, .Name 'Change references from master workbook to current workbook
            'If workbook was protected, reprotect it with same protection password
            If bProtectedWB = True Then .Protect sWBProtectPassword
            'Close file and save the changes
        If Not IsEmpty(varLinks) Then
            For i = 1 To UBound(varLinks)
                .BreakLink _
                    Name:=varLinks(i), _
            Next i
        End If
        .Close True

    End With

    sFileName = Dir 'Advance to next file in the folder

'Re-enable screenupdating and alerts
xl.ScreenUpdating = True
xl.DisplayAlerts = True

MsgBox "Added Tab to all PLOG files"

This post has been edited by aggiemarine07: Aug 13 2019, 09:19 AM
Go to the top of the page
Start new topic
post Aug 13 2019, 10:46 AM

Access Wiki and Forums Moderator
Posts: 76,409
Joined: 19-June 07
From: SunnySandyEggo

Hi. I don't see any error handler in your code. Did you say you added one?

Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page

Posts in this topic

Custom Search

RSSSearch   Top   Lo-Fi    21st October 2019 - 02:33 AM