Public Function GetCellFromClosedWorkbook( _
ByVal WorkbookPath As String, _
ByVal WorkbookName As String, _
ByVal WorksheetName As String, _
ByVal CellReference As String, _
Optional ByVal FirstRow As Long, _
Optional ByVal FirstColumn As Long _
) As Variant
' Read a cell value from a closed workbook. WorkbookPath is a string containing the full path to the folder
' containing the closed workbook. WorkbookName is a string containing the workbook name including the file
' extension. WorksheetName is a string containing the name of the worksheet from which to pull the value.
' CellReference is a string containing the cell address in A1 reference style. The closed workbook cannot
' be password protected.
Dim Connection As Object
Dim RecordSet As Object
Dim SQL As String
' Append trailing slash
If Right(WorkbookPath, 1) <> "\" Then
WorkbookPath = WorkbookPath & "\"
End If
' Check for valid path name
If Len(Dir(WorkbookPath & WorkbookName)) = 0 Then
GetCellFromClosedWorkbook = "#Bad Path or File!"
Exit Function
End If
' Open the ADODB connection and record set
Set Connection = CreateObject("ADODB.Connection")
With Connection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties") = "Excel 8.0;HDR=NO;IMEX=1"
.Open WorkbookPath & WorkbookName
End With
Set RecordSet = CreateObject("ADODB.Recordset")
RecordSet.Open "SELECT * From [" & WorksheetName & "$]", Connection, 1, 1 ' adOpenKeyset, adLockReadOnly
' Check range
If Range(CellReference).Column - FirstColumn > RecordSet.Fields.Count _
Or Range(CellReference).Row <= FirstRow _
Or Range(CellReference).Column <= FirstColumn _
Then
GetCellFromClosedWorkbook = "#Bad Reference!"
Exit Function
End If
' Pull the cell value from the record set
If Range(CellReference).Row - FirstRow = 1 Then
GetCellFromClosedWorkbook = RecordSet.Fields(Range(CellReference).Column - FirstColumn - 1)
Else
RecordSet.Move Range(CellReference).Row - FirstRow - 2
If RecordSet.EOF Then
GetCellFromClosedWorkbook = "#Bad Reference!"
Exit Function
End If
GetCellFromClosedWorkbook = RecordSet.Fields(Range(CellReference).Column - FirstColumn - 1)
End If
' Clean up
RecordSet.Close
Connection.Close
End Function
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
Connect with Certified Experts to gain insight and support on specific technology challenges including:
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE