Process Files From List Macro - Help

[Shireyml]

I am new to macros and recently upgraded from 2013 32 bit to 2013 64 bit. Under 32 bit, my team and I were successfully using a macro that automatically opened password protected files on our network shared drive. However, now that we've switched to 64 bit, the file crashes almost every instance upon opening (sometimes just shortly after opening). Does anyone know what's causing this? I will post the VBA code below (which was written by an analyst who has since left the company). Thanks in advance!



Sub ProcessFilesFromAList()


Const sFileListSheetNAME = "FileList"
Const sFileListFileNameCOLUMN = "A"
Const sFileListPasswordCOLUMN = "B"
Const sFileListWritePasswordCOLUMN = "C"
Const nFileListHeaderROW = 1


Dim iCount As Long
Dim iError As Long
Dim iErrorCount As Long
Dim iOutputRow As Long
Dim iSourceRow As Long

Dim bNeedMore As Boolean

Dim sPassword As String
Dim rwPassword As String
Dim ReadOnlyRec As String
Dim sPath As String
Dim SPathAndFileName As String
Dim sFileName As String

'Disable Macros from running in subordinate workbooks
Application.EnableEvents = False

'Clear the output range
ThisWorkbook.Sheets("Sheet1").Rows("21:65000").Clear


'Get the folder name
sPath = Trim(ThisWorkbook.Sheets("Sheet1").Range("D3").Text)
If Len(sPath) = 0 Then
Debug.Print "There is no Folder Name specified in 'Sheet1' Cell 'D3'."
End If

'Make sure the path has a trailing backslash
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If

'Define the row before the first output row number
iOutputRow = 20

'Make sure the folder exists
If LJMFolderExists(sPath) = False Then
'Output a message
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = _
"TERMINATING. Folder does not exist. Folder: ' " & sPath & "'"
ThisWorkbook.Sheets("Sheet1").Rows(iOutputRow).Interior.Color = RGB(255, 0, 0) 'Red
Exit Sub
End If


'Initialize the Source Row
iSourceRow = nFileListHeaderROW



'Loop until all matching files have been found
bNeedMore = True
While bNeedMore
'Debug.Print sPath & sFileName

'Increment the found file count
iCount = iCount + 1

'Increment the source row number
iSourceRow = iSourceRow + 1

'Get the next 'File Name','Password', 'Read Write Password' and 'Read Only Recommendation' (removing leading and trailing spaces)
sFileName = Trim(ThisWorkbook.Sheets(sFileListSheetNAME).Cells(iSourceRow, sFileListFileNameCOLUMN).Text)
sPassword = Trim(ThisWorkbook.Sheets(sFileListSheetNAME).Cells(iSourceRow, sFileListPasswordCOLUMN).Text)
rwPassword = Trim(ThisWorkbook.Sheets(sFileListSheetNAME).Cells(iSourceRow, sFileListWritePasswordCOLUMN).Text)
ReadOnlyRec = True
'Terminate if 'File Name' is blank
If Len(sFileName) = 0 Then
bNeedMore = False
Else

'Create the path and file name combination
SPathAndFileName = sPath & sFileName

'Output a message
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = _
Format(iCount, "00") & " Processing file - " & SPathAndFileName

'Scroll down so the user can follow progress
ActiveWindow.SmallScroll Down:=1

'Process the next file
iError = ProcessOneFile(sPath, sFileName, sPassword, rwPassword, ReadOnlyRec)

Select Case iError

Case 1
'File NOT FOUND - Output a message
iErrorCount = iErrorCount + 1
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = _
Format(iCount, "00") & " File NOT FOUND - " & SPathAndFileName
ThisWorkbook.Sheets("Sheet1").Rows(iOutputRow).Interior.Color = RGB(255, 0, 0) 'Red

Case 2
iErrorCount = iErrorCount + 1
'File ALREADY OPEN - Output a message
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = _
Format(iCount, "00") & " File ALREADY OPEN - " & SPathAndFileName
ThisWorkbook.Sheets("Sheet1").Rows(iOutputRow).Interior.Color = RGB(255, 0, 0) 'Red

Case 1004
iErrorCount = iErrorCount + 1
'File ALREADY OPEN - Output a message
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = _
Format(iCount, "00") & " WRONG PASSWORD - " & SPathAndFileName
ThisWorkbook.Sheets("Sheet1").Rows(iOutputRow).Interior.Color = RGB(255, 0, 0) 'Red

Case Is <> 0
iErrorCount = iErrorCount + 1
'File ALREADY OPEN - Output a message
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = _
Format(iCount, "00") & " RUNTIME ERROR " & iError & "- " & SPathAndFileName
ThisWorkbook.Sheets("Sheet1").Rows(iOutputRow).Interior.Color = RGB(255, 0, 0) 'Red

End Select

End If

'Set the focus on this file
ThisWorkbook.Activate

Wend

'Display a 'done' message
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = "Processing Completed with " & iErrorCount & " ERRORS."


If iCount = 0 Then
iOutputRow = iOutputRow + 1
ThisWorkbook.Sheets("Sheet1").Cells(iOutputRow, 1) = "There were NO .files to process on Sheet '" & sFileListSheetNAME & "'"
End If


'Enable Macros
Application.EnableEvents = True


End Sub


Function ProcessOneFile(sPath As String, sFileName As String, sPassword As String, rwPassword As String, ReadOnlyRec As String) As Long
'This processes a file
'
'The following Errors are returned:
' 0 = no known error
' 1 = path and file not found
' 2 = file already open
' 1004 = Bad password


Dim ws As Worksheet

Dim iError As Long

Dim SPathAndFileName As String

'Create the path and file name combination
SPathAndFileName = sPath & sFileName


'Verify that the file exists
If LJMFileExists(SPathAndFileName) = False Then
iError = 1
GoTo ERROR_EXIT
End If

'Verify that the file is NOT already open
If LjmIsWorkbookOpen(sFileName) = True Then
iError = 2
GoTo ERROR_EXIT
End If


'Open the file
On Error GoTo ERROR_EXIT:
Workbooks.Open FileName:=SPathAndFileName, Password:=sPassword, WriteResPassword:=rwPassword, IgnoreReadOnlyRecommended:=ReadOnlyRec



Exit Function

ERROR_EXIT:

'Set failure error return
ProcessOneFile = Err.Number

If ProcessOneFile = 0 Then
ProcessOneFile = iError
End If

On Error GoTo 0


End Function






Public Function LJMFileExists(sPathAndFullFileName As String) As Boolean
'This returns TRUE if a file exists and FALSE if a file does NOT exist

Dim iError As Integer
Dim iFileAttributes As Integer


On Error Resume Next
iFileAttributes = GetAttr(sPathAndFullFileName)

'Check the internal error return
iError = Err.Number
Select Case iError
Case Is = 0
iFileAttributes = iFileAttributes And vbDirectory
If iFileAttributes = 0 Then
LJMFileExists = True
Else
LJMFileExists = False
End If
Case Else
LJMFileExists = False
End Select


On Error GoTo 0


End Function


Public Function LJMFolderExists(sPathAndFolderName As String) As Boolean
'This returns TRUE if a folder exists and FALSE if a folder does NOT exist
'This will return FALSE if the 'sPathAndFullFileName' is a file

Dim iFileAttributes As Integer


On Error Resume Next
iFileAttributes = GetAttr(sPathAndFolderName)
iFileAttributes = iFileAttributes And vbDirectory
On Error GoTo 0

LJMFolderExists = False
If iFileAttributes = vbDirectory Then
LJMFolderExists = True
End If

End Function


Function LjmIsWorkbookOpen(sName As String) As Boolean
'Return value TRUE if workbook is open


Dim wb As Workbook


On Error Resume Next


Set wb = Workbooks(sName)
LjmIsWorkbookOpen = Not wb Is Nothing

On Error GoTo 0

End Function