By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,587 Members | 1,071 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,587 IT Pros & Developers. It's quick & easy.

Add xls Macros to existing Module.

P: n/a
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(sXlsPathRoot_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.Application
Dim xlsWorkBk As Excel.Workbook

Set xlsApp = New Excel.Application

Set rsPIW = CurrentDb.OpenRecordset("t_piw_export_2004")

Set rsFundList = CurrentDb.OpenRecordset("schd_fund_list")
Do Until rsFundList.EOF

sFundNum = rsFundList(0)
'
' Do Schedule D
'

Set qdDelXlsTbl = CurrentDb.QueryDefs("schd_purge")
qdDelXlsTbl.Execute

Set qdGenXlsTbl = CurrentDb.QueryDefs("load_schd_2004_Part1")
qdGenXlsTbl.Parameters("prm_fund_num") = sFundNum
qdGenXlsTbl.Execute

sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "a.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel4,
"t_schd_export_2004", sXlsFilePath

Set xlsWorkBk = xlsApp.Workbooks.Open(sXlsFilePath)
xlsWorkBk.Worksheets(1).Columns(1).Delete
xlsWorkBk.Worksheets(1).Rows(1).Delete
xlsWorkBk.Save
xlsWorkBk.Close

Set qdDelXlsTbl = CurrentDb.QueryDefs("schd_purge")
qdDelXlsTbl.Execute

Set qdGenXlsTbl = CurrentDb.QueryDefs("load_schd_2004_Part2")
qdGenXlsTbl.Parameters("prm_fund_num") = sFundNum
qdGenXlsTbl.Execute

sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "b.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel4,
"t_schd_export_2004", sXlsFilePath

Set xlsWorkBk = xlsApp.Workbooks.Open(sXlsFilePath)

xlsWorkBk.Worksheets(1).Rows(1).Delete

xlsWorkBk.Save
xlsWorkBk.Close
'
' Do Schedule H
'

Set qdDelXlsTbl = CurrentDb.QueryDefs("schh_purge")
qdDelXlsTbl.Execute

Set qdGenXlsTbl = CurrentDb.QueryDefs("load_sch_h2004")
qdGenXlsTbl.Parameters("prm_fund_num") = sFundNum
qdGenXlsTbl.Execute

sXlsFilePath = sXlsPathRoot_H & "04h" & sFundNum & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel4,
"t_schh_export_2004", sXlsFilePath

Set xlsWorkBk = xlsApp.Workbooks.Open(sXlsFilePath)
xlsWorkBk.Worksheets(1).Rows(1).Delete
xlsWorkBk.Save
xlsWorkBk.Close
'
' Do Plan Information Worksheet
'
' rsPIW.MoveFirst
' rsPIW.Edit
' rsPIW.Fields("g") = Mid(rsFundList.Fields("fund_ein"), 1,
2)
' rsPIW.Fields("h") = Mid(rsFundList.Fields("fund_ein"), 3,
7)
' rsPIW.Fields("i") = Left(rsFundList.Fields("fund_nm"), 48)
' rsPIW.Fields("j") = Left(rsFundList.Fields("fund_nm"), 48)
' rsPIW.Update
' sXlsFilePath = sXlsPathRoot_P & "p" & sFundNum & ".xls"
' DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel4,
"t_piw_export_2000", sXlsFilePath

' Set xlsWorkBk = xlsApp.Workbooks.Open(sXlsFilePath)
' xlsWorkBk.Worksheets(1).Rows(1).Delete
' xlsWorkBk.Save
' xlsWorkBk.Close

rsFundList.MoveNext
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.ScreenUpdating = False

Application.DisplayAlerts = False

Application.ReferenceStyle = 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.Paste

SC = SC + 4

Counter = Counter + 1

If Counter = 8 Then

SR = SR + 1

Counter = 0

SC = 1

Else: SR = SR

End If

Next

Application.ReferenceStyle = xlA1

Range("AG" & 9, "AG" & SR) = "~5x4"

Range("A" & SR + 1, "D" & 65536).Select

Selection.ClearContents

Range("A1").Activate

Application.ScreenUpdating = True

Application.DisplayAlerts = 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.ScreenUpdating = False

Application.DisplayAlerts = False

Application.ReferenceStyle = 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.Paste

SC = SC + 6

Counter = Counter + 1

If Counter = 6 Then

SR = SR + 1

Counter = 0

SC = 1

Else: SR = SR

End If

Next

Application.ReferenceStyle = xlA1

Range("AK" & 9, "AK" & SR) = "~3x4"

Range("A" & SR + 1, "F" & 65536).Select

Selection.ClearContents

Range("A1").Activate

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub
-------------------------------------------------------------------

' Do Schedule D
'

Set qdDelXlsTbl = CurrentDb.QueryDefs("schd_purge")
qdDelXlsTbl.Execute

Set qdGenXlsTbl = CurrentDb.QueryDefs("load_schd_2004_Part1")
qdGenXlsTbl.Parameters("prm_fund_num") = sFundNum
qdGenXlsTbl.Execute

sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "a.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel4,
"t_schd_export_2004", sXlsFilePath

Set xlsWorkBk = xlsApp.Workbooks.Open(sXlsFilePath)
xlsWorkBk.Worksheets(1).Columns(1).Delete
xlsWorkBk.Worksheets(1).Rows(1).Delete

<<<<I WOULD MACRO A TO RUN HERE>>>

xlsWorkBk.Save
xlsWorkBk.Close

Set qdDelXlsTbl = CurrentDb.QueryDefs("schd_purge")
qdDelXlsTbl.Execute

Set qdGenXlsTbl = CurrentDb.QueryDefs("load_schd_2004_Part2")
qdGenXlsTbl.Parameters("prm_fund_num") = sFundNum
qdGenXlsTbl.Execute

sXlsFilePath = sXlsPathRoot_D & "04d" & sFundNum & "b.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel4,
"t_schd_export_2004", sXlsFilePath

Set xlsWorkBk = xlsApp.Workbooks.Open(sXlsFilePath)

xlsWorkBk.Worksheets(1).Rows(1).Delete

<<<<I WOULD MACRO B TO RUN HERE>>>

xlsWorkBk.Save
xlsWorkBk.Close
Any advice would be appreciated.

Nov 13 '05 #1
Share this question for a faster answer!
Share on Google+

This discussion thread is closed

Replies have been disabled for this discussion.