B
Bryan44
I am using code from Ron de Bruin (thanks very much by the way!!!) to pull
data from a closed Workbook residing on a server on our network. This closed
workbook holds project historical data used in the workbook I am making the
call from. This closed workbook holds dates, integers, floating point
numbers, and text. The ADO code Ron provides examples of pulls the dates,
integers, and floating point numbers but not the text. The code is as
follows:
Option Explicit
Public Sub GetData(SourceFile As Variant, _
SourceSheet As String, _
SourceRange As String, _
DestinationRange As Range, _
GetHeader As Boolean, _
UseHeaderRow As Boolean)
' Setup variables
Dim RecordSetData As ADODB.Recordset
Dim DBConnectString As String
Dim SQLCommandObject As String
Dim LoopCounter As Long
' Build the SQL Command to pull the data from the source DB.
SQLCommandObject = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$
& "];"
' If GetHeader determines whether or not to pull the header information
off the top row of the
' range and put it, if it is true, into the DestinationRange.
If GetHeader = False Then
DBConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
DBConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If
On Error GoTo ErrorHandler
Set RecordSetData = New ADODB.Recordset
RecordSetData.Open SQLCommandObject, DBConnectString, adOpenForwardOnly,
adLockReadOnly, adCmdText
' Check to make sure we received data and copy the data
If Not RecordSetData.EOF Then
If GetHeader = False Then
DestinationRange.Cells(1, 1).CopyFromRecordset RecordSetData
Else
'Add the GetHeader cell in each column if the last argument is
True
If UseHeaderRow Then
For LoopCounter = 0 To RecordSetData.Fields.Count - 1
DestinationRange.Cells(1, 1 + LoopCounter).Value =
RecordSetData.Fields(LoopCounter).Name
Next LoopCounter
DestinationRange.Cells(2, 1).CopyFromRecordset RecordSetData
Else
DestinationRange.Cells(1, 1).CopyFromRecordset RecordSetData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
' Clean up our Recordset object.
RecordSetData.Close
Set RecordSetData = Nothing
Exit Sub
ErrorHandler:
MsgBox "FPE Tool Error: The file name, Sheet name or Range is not valid
of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub
I have changed the format of the closed workbook text to "General" then to
"Text" but it doesn't make any difference. The ADO call will not pull text
for what ever reason. Curious though, it will pull the first row if you set
getheader and useheader to true but concatinates sequential integers on the
end of the second column (i.e., name, name1, name2, .... name256). Perhaps
someone can help me understand what is not right or what I need to change to
get an entire set of data that includes all of the information stored in the
closed workbook. BTW, this call works terrific on the local network and even
acceptable accross a VPN interface.
Sincerely,
Bryan44
data from a closed Workbook residing on a server on our network. This closed
workbook holds project historical data used in the workbook I am making the
call from. This closed workbook holds dates, integers, floating point
numbers, and text. The ADO code Ron provides examples of pulls the dates,
integers, and floating point numbers but not the text. The code is as
follows:
Option Explicit
Public Sub GetData(SourceFile As Variant, _
SourceSheet As String, _
SourceRange As String, _
DestinationRange As Range, _
GetHeader As Boolean, _
UseHeaderRow As Boolean)
' Setup variables
Dim RecordSetData As ADODB.Recordset
Dim DBConnectString As String
Dim SQLCommandObject As String
Dim LoopCounter As Long
' Build the SQL Command to pull the data from the source DB.
SQLCommandObject = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$
& "];"
' If GetHeader determines whether or not to pull the header information
off the top row of the
' range and put it, if it is true, into the DestinationRange.
If GetHeader = False Then
DBConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
DBConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If
On Error GoTo ErrorHandler
Set RecordSetData = New ADODB.Recordset
RecordSetData.Open SQLCommandObject, DBConnectString, adOpenForwardOnly,
adLockReadOnly, adCmdText
' Check to make sure we received data and copy the data
If Not RecordSetData.EOF Then
If GetHeader = False Then
DestinationRange.Cells(1, 1).CopyFromRecordset RecordSetData
Else
'Add the GetHeader cell in each column if the last argument is
True
If UseHeaderRow Then
For LoopCounter = 0 To RecordSetData.Fields.Count - 1
DestinationRange.Cells(1, 1 + LoopCounter).Value =
RecordSetData.Fields(LoopCounter).Name
Next LoopCounter
DestinationRange.Cells(2, 1).CopyFromRecordset RecordSetData
Else
DestinationRange.Cells(1, 1).CopyFromRecordset RecordSetData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
' Clean up our Recordset object.
RecordSetData.Close
Set RecordSetData = Nothing
Exit Sub
ErrorHandler:
MsgBox "FPE Tool Error: The file name, Sheet name or Range is not valid
of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub
I have changed the format of the closed workbook text to "General" then to
"Text" but it doesn't make any difference. The ADO call will not pull text
for what ever reason. Curious though, it will pull the first row if you set
getheader and useheader to true but concatinates sequential integers on the
end of the second column (i.e., name, name1, name2, .... name256). Perhaps
someone can help me understand what is not right or what I need to change to
get an entire set of data that includes all of the information stored in the
closed workbook. BTW, this call works terrific on the local network and even
acceptable accross a VPN interface.
Sincerely,
Bryan44