Hello-
I am fairly new to MS Access and would like to use some macros in .xls
in an Access Module. I have tried to do this on my own but failed to
make it work. I have included the xls macros and the module as well as
where I would like the macros to run. Any input on how to make this
work would be appreciated. This would automate a former 3 step process
into one process.
module
Public Function clean_pn(pn_in As Variant) As String
End Function
Dim pn_out As String
If IsNull(pn_in) Or pn_in = "" Then pn_in = "000"
If pn_in = "VEBA" Then
pn_out = "001"
Else
pn_out = pn_in
End If
clean_pn = pn_out
End Function
Public Sub export_schd04(s XlsPathRoot_P As String, sXlsPathRoot_D As
String, sXlsPathRoot_H As String)
Dim sFundNum As String
Dim sXlsFilePath As String
Dim qdGenXlsTbl As QueryDef
Dim qdDelXlsTbl As QueryDef
Dim rsFundList As Recordset
Dim rsPIW As Recordset
' Dim xlsapp As Application
Dim xlsApp As Excel.Applicati on
Dim xlsWorkBk As Excel.Workbook
Set xlsApp = New Excel.Applicati on
Set rsPIW = CurrentDb.OpenR ecordset("t_piw _export_2004")
Set rsFundList = CurrentDb.OpenR ecordset("schd_ fund_list")
Do Until rsFundList.EOF
sFundNum = rsFundList(0)
'
' Do Schedule D
'
Set qdDelXlsTbl = CurrentDb.Query Defs("schd_purg e")
qdDelXlsTbl.Exe cute
Set qdGenXlsTbl = CurrentDb.Query Defs("load_schd _2004_Part1")
qdGenXlsTbl.Par ameters("prm_fu nd_num") = sFundNum
qdGenXlsTbl.Exe cute
sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "a.xls"
DoCmd.TransferS preadsheet acExport, acSpreadsheetTy peExcel4,
"t_schd_export_ 2004", sXlsFilePath
Set xlsWorkBk = xlsApp.Workbook s.Open(sXlsFile Path)
xlsWorkBk.Works heets(1).Column s(1).Delete
xlsWorkBk.Works heets(1).Rows(1 ).Delete
xlsWorkBk.Save
xlsWorkBk.Close
Set qdDelXlsTbl = CurrentDb.Query Defs("schd_purg e")
qdDelXlsTbl.Exe cute
Set qdGenXlsTbl = CurrentDb.Query Defs("load_schd _2004_Part2")
qdGenXlsTbl.Par ameters("prm_fu nd_num") = sFundNum
qdGenXlsTbl.Exe cute
sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "b.xls"
DoCmd.TransferS preadsheet acExport, acSpreadsheetTy peExcel4,
"t_schd_export_ 2004", sXlsFilePath
Set xlsWorkBk = xlsApp.Workbook s.Open(sXlsFile Path)
xlsWorkBk.Works heets(1).Rows(1 ).Delete
xlsWorkBk.Save
xlsWorkBk.Close
'
' Do Schedule H
'
Set qdDelXlsTbl = CurrentDb.Query Defs("schh_purg e")
qdDelXlsTbl.Exe cute
Set qdGenXlsTbl = CurrentDb.Query Defs("load_sch_ h2004")
qdGenXlsTbl.Par ameters("prm_fu nd_num") = sFundNum
qdGenXlsTbl.Exe cute
sXlsFilePath = sXlsPathRoot_H & "04h" & sFundNum & ".xls"
DoCmd.TransferS preadsheet acExport, acSpreadsheetTy peExcel4,
"t_schh_export_ 2004", sXlsFilePath
Set xlsWorkBk = xlsApp.Workbook s.Open(sXlsFile Path)
xlsWorkBk.Works heets(1).Rows(1 ).Delete
xlsWorkBk.Save
xlsWorkBk.Close
'
' Do Plan Information Worksheet
'
' rsPIW.MoveFirst
' rsPIW.Edit
' rsPIW.Fields("g ") = Mid(rsFundList. Fields("fund_ei n"), 1,
2)
' rsPIW.Fields("h ") = Mid(rsFundList. Fields("fund_ei n"), 3,
7)
' rsPIW.Fields("i ") = Left(rsFundList .Fields("fund_n m"), 48)
' rsPIW.Fields("j ") = Left(rsFundList .Fields("fund_n m"), 48)
' rsPIW.Update
' sXlsFilePath = sXlsPathRoot_P & "p" & sFundNum & ".xls"
' DoCmd.TransferS preadsheet acExport, acSpreadsheetTy peExcel4,
"t_piw_export_2 000", sXlsFilePath
' Set xlsWorkBk = xlsApp.Workbook s.Open(sXlsFile Path)
' xlsWorkBk.Works heets(1).Rows(1 ).Delete
' xlsWorkBk.Save
' xlsWorkBk.Close
rsFundList.Move Next
Loop
MsgBox "Files Generated", vbOKOnly, ""
End Sub
-------------------------------------------------------------------
xls macro A
Sch_D Part 1.
Sub CreateFile()
Dim SN, LN As Variant
Dim Counter, SR, SC As Integer
'SN = Start Name, LN = Last Name, SR = Start Row, SC = Start Column
Application.Scr eenUpdating = False
Application.Dis playAlerts = False
Application.Ref erenceStyle = xlR1C1
LN = Range("A65536") .End(xlUp).Row
SR = 9
SC = 1
Counter = 0
For SN = 9 To LN
Range("A" & SN & ":D" & SN).Select
Selection.Copy
Cells(SR, SC).Select
ActiveSheet.Pas te
SC = SC + 4
Counter = Counter + 1
If Counter = 8 Then
SR = SR + 1
Counter = 0
SC = 1
Else: SR = SR
End If
Next
Application.Ref erenceStyle = xlA1
Range("AG" & 9, "AG" & SR) = "~5x4"
Range("A" & SR + 1, "D" & 65536).Select
Selection.Clear Contents
Range("A1").Act ivate
Application.Scr eenUpdating = True
Application.Dis playAlerts = True
End Sub
-------------------------------------------------------------------
xls Macro 2
Sch_D_Part 2
Sub createfile_2()
Dim SN, LN As Variant
Dim Counter, SR, SC As Integer
'SN = Start Name, LN = Last Name, SR = Start Row, SC = Start Column
Application.Scr eenUpdating = False
Application.Dis playAlerts = False
Application.Ref erenceStyle = xlR1C1
LN = Range("A65536") .End(xlUp).Row
SR = 9
SC = 1
Counter = 0
For SN = 9 To LN
Range("A" & SN & ":F" & SN).Select
Selection.Copy
Cells(SR, SC).Select
ActiveSheet.Pas te
SC = SC + 6
Counter = Counter + 1
If Counter = 6 Then
SR = SR + 1
Counter = 0
SC = 1
Else: SR = SR
End If
Next
Application.Ref erenceStyle = xlA1
Range("AK" & 9, "AK" & SR) = "~3x4"
Range("A" & SR + 1, "F" & 65536).Select
Selection.Clear Contents
Range("A1").Act ivate
Application.Scr eenUpdating = True
Application.Dis playAlerts = True
End Sub
-------------------------------------------------------------------
' Do Schedule D
'
Set qdDelXlsTbl = CurrentDb.Query Defs("schd_purg e")
qdDelXlsTbl.Exe cute
Set qdGenXlsTbl = CurrentDb.Query Defs("load_schd _2004_Part1")
qdGenXlsTbl.Par ameters("prm_fu nd_num") = sFundNum
qdGenXlsTbl.Exe cute
sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "a.xls"
DoCmd.TransferS preadsheet acExport, acSpreadsheetTy peExcel4,
"t_schd_export_ 2004", sXlsFilePath
Set xlsWorkBk = xlsApp.Workbook s.Open(sXlsFile Path)
xlsWorkBk.Works heets(1).Column s(1).Delete
xlsWorkBk.Works heets(1).Rows(1 ).Delete
<<<<I WOULD MACRO A TO RUN HERE>>>
xlsWorkBk.Save
xlsWorkBk.Close
Set qdDelXlsTbl = CurrentDb.Query Defs("schd_purg e")
qdDelXlsTbl.Exe cute
Set qdGenXlsTbl = CurrentDb.Query Defs("load_schd _2004_Part2")
qdGenXlsTbl.Par ameters("prm_fu nd_num") = sFundNum
qdGenXlsTbl.Exe cute
sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "b.xls"
DoCmd.TransferS preadsheet acExport, acSpreadsheetTy peExcel4,
"t_schd_export_ 2004", sXlsFilePath
Set xlsWorkBk = xlsApp.Workbook s.Open(sXlsFile Path)
xlsWorkBk.Works heets(1).Rows(1 ).Delete
<<<<I WOULD MACRO B TO RUN HERE>>>
xlsWorkBk.Save
xlsWorkBk.Close
Any advice would be appreciated.
