G
Guest
Hello -
Could you help me with the code below that I found in an older posting and
was trying to adapt it to my needs? I believe what the code is just missing
is the beginning sub () and the end sub, and maybe the Getcn definition. I am
not familiar with VB in Access and connecting Access to Excel . What I would
like to do is just copy the code and paste it in a new Excel module and just
have it functional. Thank you.
Dim qdf As DAO.Querydef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String
Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
strSQL = "SELECT DISTINCT [Lawson dept] FROM [OP Volume];"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
'
' deleted the DLookup step
'
strMgr = rstMgr![Lawson dept].Value
'
' added ' characters to delimit the manager's last name string
'
strSQL = "SELECT * FROM [OP Volume] WHERE " & "[Lawson dept] = '" & strMgr &
"';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.Sql = strSQL
qdf.Close
Set qdf = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTemp,
"C:\Temp\" & strMgr & Format(Now(), "mmddyyyy") & ".xls"
rstMgr.MoveNext
Loop
End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
Could you help me with the code below that I found in an older posting and
was trying to adapt it to my needs? I believe what the code is just missing
is the beginning sub () and the end sub, and maybe the Getcn definition. I am
not familiar with VB in Access and connecting Access to Excel . What I would
like to do is just copy the code and paste it in a new Excel module and just
have it functional. Thank you.
Dim qdf As DAO.Querydef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String
Const strQName As String = "zExportQuery"
Set dbs = CurrentDb
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
strSQL = "SELECT DISTINCT [Lawson dept] FROM [OP Volume];"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
'
' deleted the DLookup step
'
strMgr = rstMgr![Lawson dept].Value
'
' added ' characters to delimit the manager's last name string
'
strSQL = "SELECT * FROM [OP Volume] WHERE " & "[Lawson dept] = '" & strMgr &
"';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.Sql = strSQL
qdf.Close
Set qdf = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTemp,
"C:\Temp\" & strMgr & Format(Now(), "mmddyyyy") & ".xls"
rstMgr.MoveNext
Loop
End If
rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing