Can someone help me understand why this doesn't work in excel 2007. It fails to find the file i specify. I have a REF sheet where the file path and workbook name are held in seperate columns and the VBA joins them together before locating the workbook - in 2003 it works fine, in 2007 it fails
Code:
Public Sub ImportWorkbookData()
Dim wkbData As Workbook
Dim wksOut As Worksheet
Dim wksData As Worksheet
Dim rngPeriodOut As Range
Dim rngOut As Range
Dim rngData As Range
Dim rngWkbList As Range
Dim rngPeriod As Range
Dim lngRow As Long
Dim lngNumProcessed As Long
Dim strWkbPath As String
Dim strOutputSheet As String
Dim strDataSheet As String
Dim strWkbName As String
Dim strProcess As String
Dim strOutputRange As String
Dim strDataRange As String
Dim dtmStart As Date
'Handle errors
On Error GoTo Error_Label
'Check the number of workbooks open before proceeding
If Application.Workbooks.Count > 2 Then
'More than one workbook open in Excel
Call MsgBox("Please close all other workbooks before running importing data.", vbOKOnly + vbInformation)
Exit Sub
'Check user wants to proceed
ElseIf MsgBox("Import data from other workbooks?", vbYesNo + vbQuestion) = vbNo Then
'User does not want to proceed
Exit Sub
End If
Call Show_Sheets
'Initialise counter
lngNumProcessed = 0
'Activate REF DATA worksheet in this workbook
ThisWorkbook.Activate
ThisWorkbook.Worksheets("REF DATA").Select
'Override application settings
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
'Set reference to named range in this workbook
Set rngWkbList = ThisWorkbook.Worksheets("REF DATA").Range("WORKBOOK_LIST")
'Run queries listed
For lngRow = 1 To rngWkbList.Rows.Count Step 1
'Get workbook details, data and output ranges
strWkbPath = Trim$(rngWkbList.Cells(lngRow, 1).Value)
strWkbName = Trim$(rngWkbList.Cells(lngRow, 2).Value)
strDataSheet = Trim$(rngWkbList.Cells(lngRow, 3).Value)
strDataRange = Trim$(rngWkbList.Cells(lngRow, 4).Value)
strOutputSheet = Trim$(rngWkbList.Cells(lngRow, 5).Value)
strOutputRange = Trim$(rngWkbList.Cells(lngRow, 6).Value)
strProcess = Trim$(UCase$(rngWkbList.Cells(lngRow, 9).Value))
'If details not blank
If strWkbPath <> vbNullString And _
strDataSheet <> vbNullString And strDataRange <> vbNullString And _
strOutputSheet <> vbNullString And strOutputRange <> vbNullString And _
strProcess = "Y" Then
'Amend path to include backslash character
If Right$(strWkbPath, 1) <> "\" Then strWkbPath = strWkbPath & "\"
'Show user progress text
ThisWorkbook.Activate
rngWkbList.Parent.Select
dtmStart = Now()
rngWkbList.Cells(lngRow, 7).Value = "Started: " & Format(dtmStart, "DD-MM-YYYY HH:MM:SS") & vbLf & "Finished: NOT FINISHED"
rngWkbList.Cells(lngRow, 8).Value = Application.UserName
Application.StatusBar = "Processing workbook " & strWkbPath & strWkbName
'Don't handle errors in this next section of code
On Error Resume Next
'Set worksheet reference (this workbook)
Err.Clear
Set wksOut = ThisWorkbook.Worksheets(strOutputSheet)
If Err.Number <> 0 Then
On Error GoTo Error_Label
Err.Raise vbObjectError + 84, "ImportWorkbookData", "Invalid output worksheet!"
Else
wksOut.Select
wksOut.Unprotect
End If
'Set range reference (this workbook)
Err.Clear
Set rngOut = wksOut.Range(strOutputRange)
If Err.Number <> 0 Then
On Error GoTo Error_Label
Err.Raise vbObjectError + 85, "ImportWorkbookData", "Invalid output range!"
Else
rngOut.Cells.ClearContents
rngOut.Cells.ClearComments
End If
'Close all other workbooks
For Each wkbData In Application.Workbooks
If UCase(wkbData.FullName) = UCase(strWkbPath & strWkbName) Then
' Do nothing, gonna use that wkbdata
Exit For
ElseIf wkbData.Name <> ThisWorkbook.Name Then
' Don't close this workbook but close any others
wkbData.Close savechanges:=False
End If
Next wkbData
'Open the data workbook
Err.Clear
If wkbData Is Nothing Then Set wkbData = Workbooks.Open(Filename:=strWkbPath & strWkbName, updatelinks:=False, ReadOnly:=True)
If Err.Number <> 0 Then
On Error GoTo Error_Label
Err.Raise vbObjectError + 85, "ImportWorkbookData", "The workbook '" & strWkbPath & "' does not exist!"
End If
wkbData.Activate
'Set reference to data sheet in data workbook
Err.Clear
Set wksData = wkbData.Worksheets(strDataSheet)
If Err.Number <> 0 Then
On Error GoTo Error_Label
Err.Raise vbObjectError + 85, "ImportWorkbookData", "The worksheet '" & strDataSheet & "' does not exist in '" & strWkbPath & "'"
Else
wksData.Select
End If
'Set reference to data range on data worksheet
Err.Clear
Set rngData = wksData.Range(strDataRange)
Set rngPeriod = wksData.Range("A1")
rngPeriod.Select
'We can use this to copy the A1 Cell from the sheet in a variable string
If Err.Number <> 0 Then
On Error GoTo Error_Label
Err.Raise vbObjectError + 85, "ImportWorkbookData", "The range '" & strDataRange & "' does not exist on the '" & strDataSheet & "' worksheet in '" & strWkbPath & "'"
End If
'Handle errors again
On Error GoTo Error_Label
'Copy the data over (and add comment for audit purposes)
rngData.Copy
ThisWorkbook.Activate
wksOut.Select
rngOut.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False
'rngPeriod.Copy
'ThisWorkbook.Activate
'Range("A1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False
'rngOut.Cells(1, 1).AddComment "Updated on " & Format(Now, "DD/MM/YYYY HH:MM:SS") & vbLf & " from " & strWkbPath & strWkbName & vbLf & strDataSheet & vbLf & "by " & Application.UserName
'Update progress text
'rngWkbList.Cells(lngRow, 7).Value = "Started: " & Format(dtmStart, "DD-MM-YYYY HH:MM:SS") & vbLf & "Finished: " & Format(Now(), "DD-MM-YYYY HH:MM:SS")
'Release resources
Set rngOut = Nothing
Set wksOut = Nothing
Set rngData = Nothing
Set wksData = Nothing
Set rngPeriod = Nothing
'Keep track of the number of workbooks processed
lngNumProcessed = lngNumProcessed + 1
End If
Next lngRow
Exit_Label:
'Don't handle errors in this section of code
On Error Resume Next
'Restore application settings
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.StatusBar = False
Application.ScreenUpdating = True
'Release resources
If Not wkbData Is Nothing Then
wkbData.Close savechanges:=False
Set wkbData = Nothing
End If
Set wksOut = Nothing
Set wksData = Nothing
Set rngOut = Nothing
Set rngData = Nothing
Set rngWkbList = Nothing
Set rngPeriod = Nothing
'Prompt user with confirmation
ThisWorkbook.Activate
' Call method to refresh Pivot Table
'Call Refresh_Pivot_Tables
'Call Hide_Sheets
ThisWorkbook.Worksheets("REF DATA").Select
Call MsgBox(lngNumProcessed & " worksheets updated.", vbOKOnly + vbInformation)
Exit Sub
'Error handler
Error_Label:
Call MsgBox(Err.Description, vbOKOnly + vbCritical, "Error detected in " & Err.Source)
Resume Exit_Label
End Sub
