had1015
03-09-2014, 06:44 AM
Hello,
I was assisted a few years age by someone in this forum with code for comparing 2 files. Now when I run the code in Windows 7, I get error 53 File not found.
If FileDateTime(mpFile1) < FileDateTime(mpFile2) Then
This is the full code:
Sub UpdateList()
Dim mpFolder As String
Dim mpFile1 As String
Dim mpFile2 As String
Dim mpWB1 As Workbook
Dim mpWB2 As Workbook
Dim mpWB3 As Workbook
Dim mpLastRow As Long
Dim i As Long
Dim relativePath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
mpFolder = .SelectedItems(1)
mpFile1 = Dir(mpFolder & Application.PathSeparator &
"*.xlsx", vbNormal)
If mpFile1 <> "" Then
mpFile2 = Dir
End If
If mpFile1 = "" Or mpFile2 = "" Then
MsgBox "Incomplete files - exiting", vbCritical, "File
Details"
Exit Sub
End If
If FileDateTime(mpFile1) < FileDateTime(mpFile2) Then
Set mpWB1 = Workbooks.Open(mpFile1)
Set mpWB2 = Workbooks.Open(mpFile2)
Else
Set mpWB1 = Workbooks.Open(mpFile2)
Set mpWB2 = Workbooks.Open(mpFile1)
End If
mpWB1.Worksheets(1).Copy
Set mpWB3 = ActiveWorkbook
ActiveWorkbook.SaveAs "Updated " & mpWB2.Name,
FileFormat:=51
mpWB2.Worksheets(1).Copy After:=mpWB3.Worksheets(1)
With mpWB3.Worksheets(2)
mpLastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = mpLastRow To 1
If .Cells(i, "F").Value =
mpWB3.Worksheets(1).Cells(i, "F").Value Then
.Rows(i).Offset(0, 11).Value =
mpWB1.Worksheets(1).Rows(i).Offset(0, 11).Value & " " &
mpWB3.Worksheets(2).Rows(i).Offset(0, 11).Value
End If
Next i
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Sheet1 (2)").Delete
End With
End If
End With
CloseAll
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
Private Sub CloseAll()
' This sub will close all workbooks
' except the workbook in which the code is located.
Dim WkbkName As Object
On Error GoTo Close_Error
Application.ScreenUpdating = False
For Each WkbkName In Application.Workbooks()
If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close
Next
' If everything runs all right, exit the sub.
Exit Sub
' Error handler.
Close_Error:
MsgBox Str(Err) & " " & Error()
Resume Next
End Sub
Private Sub ExplorePath()
Shell Environ("windir") & "\Explorer.exe " & ActiveWorkbook.Path,
vbMaximizedFocus
End Sub
Thank you for your assistance.
I was assisted a few years age by someone in this forum with code for comparing 2 files. Now when I run the code in Windows 7, I get error 53 File not found.
If FileDateTime(mpFile1) < FileDateTime(mpFile2) Then
This is the full code:
Sub UpdateList()
Dim mpFolder As String
Dim mpFile1 As String
Dim mpFile2 As String
Dim mpWB1 As Workbook
Dim mpWB2 As Workbook
Dim mpWB3 As Workbook
Dim mpLastRow As Long
Dim i As Long
Dim relativePath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
mpFolder = .SelectedItems(1)
mpFile1 = Dir(mpFolder & Application.PathSeparator &
"*.xlsx", vbNormal)
If mpFile1 <> "" Then
mpFile2 = Dir
End If
If mpFile1 = "" Or mpFile2 = "" Then
MsgBox "Incomplete files - exiting", vbCritical, "File
Details"
Exit Sub
End If
If FileDateTime(mpFile1) < FileDateTime(mpFile2) Then
Set mpWB1 = Workbooks.Open(mpFile1)
Set mpWB2 = Workbooks.Open(mpFile2)
Else
Set mpWB1 = Workbooks.Open(mpFile2)
Set mpWB2 = Workbooks.Open(mpFile1)
End If
mpWB1.Worksheets(1).Copy
Set mpWB3 = ActiveWorkbook
ActiveWorkbook.SaveAs "Updated " & mpWB2.Name,
FileFormat:=51
mpWB2.Worksheets(1).Copy After:=mpWB3.Worksheets(1)
With mpWB3.Worksheets(2)
mpLastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = mpLastRow To 1
If .Cells(i, "F").Value =
mpWB3.Worksheets(1).Cells(i, "F").Value Then
.Rows(i).Offset(0, 11).Value =
mpWB1.Worksheets(1).Rows(i).Offset(0, 11).Value & " " &
mpWB3.Worksheets(2).Rows(i).Offset(0, 11).Value
End If
Next i
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Sheet1 (2)").Delete
End With
End If
End With
CloseAll
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
Private Sub CloseAll()
' This sub will close all workbooks
' except the workbook in which the code is located.
Dim WkbkName As Object
On Error GoTo Close_Error
Application.ScreenUpdating = False
For Each WkbkName In Application.Workbooks()
If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close
Next
' If everything runs all right, exit the sub.
Exit Sub
' Error handler.
Close_Error:
MsgBox Str(Err) & " " & Error()
Resume Next
End Sub
Private Sub ExplorePath()
Shell Environ("windir") & "\Explorer.exe " & ActiveWorkbook.Path,
vbMaximizedFocus
End Sub
Thank you for your assistance.