mtampa
Board Regular
- Joined
- Oct 15, 2007
- Messages
- 61
Hi guys,
First off, thanks for all your help. I have no real training in VBA but I'm the only one at my office who sorta find his way through it from time to time working on these older reports I inherited.
I was able to successfully modify my Access database to add a new column in my AS400 query.
I was running a get macro to find ceiling and sold and now I'm looking for options. I was able to successfully set up my database and grab the desired information correctly, now I'm trying to modify the Excel report.
Normally, I've been successful simply looking at the code and adding what I need, but this time I'm stuck. I added OPTION, but continue to get the same error. Here is my code: (my error line is bolded)
Sub ADOImportFromAccessbyCols(DBFullName As String, _
sStr As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
'.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
.Open sStr, cn, , , adCmdText
' filter records
'RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
'For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
'Next
TargetRange.Offset(0, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Sub GetData2(sReadDate As String)
sTable = "(select distinct ceil, option, sold, dReadDate, dDeparture,category,village_code, occ from tblAvailClean)"
'If Sheets("Main").Range("M24") <> vba.Date Then
'sTable = "tblAvailCleanHist"
'End If
Dim sStr As String
Dim n As Range
Dim dlDate As Date
Dim dsDate As Date
Dim wsName As String
Dim wkSht As Worksheet
wsName = Application.ActiveSheet.Name
sDateString = "dateserial(" & VBA.Mid(sReadDate, 7, 4) & "," & VBA.Mid(sReadDate, 1, 2) & "," & _
VBA.Mid(sReadDate, 4, 2) & ")"
'loop all cats
'If (wsName <> "CARC") Then
'If (wsName <> "SANC") Then
For Each n In ActiveSheet.Range("CAPA").Cells
sVcode = n.Parent.Name
sCat = VBA.Trim(Cells(2, n.Column))
sStr = "SELECT sum(ceil*1) AS CEIL, sum(sold*1)AS SOLD, sum(option*1) AS OPTION FROM " & sTable & _
" WHERE dReadDate=" & sDateString & " and dDeparture between dateserial(2012,10,27) and dateserial(2013,05,04) " & _
"and village_code='" & sVcode & "' and category='" & sCat & "' group by dDeparture order by dDeparture"
ADOImportFromAccessbyCols "\\cgassv0001\revenue\DSS\DBs\Inventory\Copy of NaInv_W13.mdb", sStr, n
Next n
'End If
' End If
On Error Resume Next
For Each n In ActiveSheet.Range("CAPANEW").Cells
sVcode = n.Parent.Name
sCat = VBA.Trim(Cells(2, n.Column))
sStr = "SELECT sum(ceil*1) AS CEIL, sum(sold*1) AS SOLD, sum(option*1) AS OPTION FROM " & sTable & _
" WHERE dReadDate=" & sDateString & " and dDeparture between dateserial(2012,10,27) and dateserial(2012,05,04) " & _
"and village_code='" & sVcode & "' and category='" & sCat & "' group by dDeparture order by dDeparture"
ADOImportFromAccessbyCols "\\cgassv0001\revenue\DSS\DBs\Inventory\Copy of NaInv_W13.mdb", sStr, n
Next n
On Error GoTo 0
End Sub
What exactly is it getting upset at? Everything is spelled correctly...the punctuatin is the same as it was previously. I'm totally lost.
First off, thanks for all your help. I have no real training in VBA but I'm the only one at my office who sorta find his way through it from time to time working on these older reports I inherited.
I was able to successfully modify my Access database to add a new column in my AS400 query.
I was running a get macro to find ceiling and sold and now I'm looking for options. I was able to successfully set up my database and grab the desired information correctly, now I'm trying to modify the Excel report.
Normally, I've been successful simply looking at the code and adding what I need, but this time I'm stuck. I added OPTION, but continue to get the same error. Here is my code: (my error line is bolded)
Sub ADOImportFromAccessbyCols(DBFullName As String, _
sStr As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
'.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
.Open sStr, cn, , , adCmdText
' filter records
'RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
'For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
'Next
TargetRange.Offset(0, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Sub GetData2(sReadDate As String)
sTable = "(select distinct ceil, option, sold, dReadDate, dDeparture,category,village_code, occ from tblAvailClean)"
'If Sheets("Main").Range("M24") <> vba.Date Then
'sTable = "tblAvailCleanHist"
'End If
Dim sStr As String
Dim n As Range
Dim dlDate As Date
Dim dsDate As Date
Dim wsName As String
Dim wkSht As Worksheet
wsName = Application.ActiveSheet.Name
sDateString = "dateserial(" & VBA.Mid(sReadDate, 7, 4) & "," & VBA.Mid(sReadDate, 1, 2) & "," & _
VBA.Mid(sReadDate, 4, 2) & ")"
'loop all cats
'If (wsName <> "CARC") Then
'If (wsName <> "SANC") Then
For Each n In ActiveSheet.Range("CAPA").Cells
sVcode = n.Parent.Name
sCat = VBA.Trim(Cells(2, n.Column))
sStr = "SELECT sum(ceil*1) AS CEIL, sum(sold*1)AS SOLD, sum(option*1) AS OPTION FROM " & sTable & _
" WHERE dReadDate=" & sDateString & " and dDeparture between dateserial(2012,10,27) and dateserial(2013,05,04) " & _
"and village_code='" & sVcode & "' and category='" & sCat & "' group by dDeparture order by dDeparture"
ADOImportFromAccessbyCols "\\cgassv0001\revenue\DSS\DBs\Inventory\Copy of NaInv_W13.mdb", sStr, n
Next n
'End If
' End If
On Error Resume Next
For Each n In ActiveSheet.Range("CAPANEW").Cells
sVcode = n.Parent.Name
sCat = VBA.Trim(Cells(2, n.Column))
sStr = "SELECT sum(ceil*1) AS CEIL, sum(sold*1) AS SOLD, sum(option*1) AS OPTION FROM " & sTable & _
" WHERE dReadDate=" & sDateString & " and dDeparture between dateserial(2012,10,27) and dateserial(2012,05,04) " & _
"and village_code='" & sVcode & "' and category='" & sCat & "' group by dDeparture order by dDeparture"
ADOImportFromAccessbyCols "\\cgassv0001\revenue\DSS\DBs\Inventory\Copy of NaInv_W13.mdb", sStr, n
Next n
On Error GoTo 0
End Sub
What exactly is it getting upset at? Everything is spelled correctly...the punctuatin is the same as it was previously. I'm totally lost.