S
Secret Squirrel
I'm using this code to import data from a specific file along with copying
some formulas in my worksheet. The way it works is that it imports starting
with the cell I've selected and then fills the rows below that. Since this
will be a daily import I'm trying to find a way that it will automatically
import the data to the next blank row instead of me having to select the cell
where the import should start. How would I go about modifying this code to do
that?
Sub TestReadDataFromWorkbook()
' fills data from a closed workbook in at the active cell
Application.Calculation = xlManual
Dim tArray As Variant, r As Long, c As Long
tArray = ReadDataFromWorkbook("C:\Shipped.xls", "A2:I100")
For r = LBound(tArray, 2) To UBound(tArray, 2)
For c = LBound(tArray, 1) To UBound(tArray, 1)
ActiveCell.Offset(r, c).Formula = tArray(c, r)
Next c
Next r
copydown
Application.Calculation = xlAutomatic
End Sub
Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As
String) As Variant
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
dbConnectionString = "DRIVER={Microsoft Excel Driver
(*.xls)};ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
On Error GoTo 0
ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all
records in rs
rs.Close
dbConnection.Close ' close the database connection
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Function
InvalidInput:
MsgBox "The source file or source range is invalid!", vbExclamation,
"Get data from closed workbook"
Set rs = Nothing
Set dbConnection = Nothing
End Function
some formulas in my worksheet. The way it works is that it imports starting
with the cell I've selected and then fills the rows below that. Since this
will be a daily import I'm trying to find a way that it will automatically
import the data to the next blank row instead of me having to select the cell
where the import should start. How would I go about modifying this code to do
that?
Sub TestReadDataFromWorkbook()
' fills data from a closed workbook in at the active cell
Application.Calculation = xlManual
Dim tArray As Variant, r As Long, c As Long
tArray = ReadDataFromWorkbook("C:\Shipped.xls", "A2:I100")
For r = LBound(tArray, 2) To UBound(tArray, 2)
For c = LBound(tArray, 1) To UBound(tArray, 1)
ActiveCell.Offset(r, c).Formula = tArray(c, r)
Next c
Next r
copydown
Application.Calculation = xlAutomatic
End Sub
Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As
String) As Variant
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
dbConnectionString = "DRIVER={Microsoft Excel Driver
(*.xls)};ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
On Error GoTo 0
ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all
records in rs
rs.Close
dbConnection.Close ' close the database connection
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Function
InvalidInput:
MsgBox "The source file or source range is invalid!", vbExclamation,
"Get data from closed workbook"
Set rs = Nothing
Set dbConnection = Nothing
End Function