Module Help!

[jpodesta@ibtco.com]

I would like to add the xls macros below to the module listed. I am
looking for advice as to the best way to go about this.



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 LIKE 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 LIKE MACRO B TO RUN HERE>>>


xlsWorkBk.Save
xlsWorkBk.Close


Any advice would be appreciated.

[pietlinden@hotmail.com]

Re: Module Help!

I know almost nothing about automating Excel, but read this article....

http://www.mvps.org/access/modules/mdl0007.htm

[pietlinden@hotmail.com]

Re: Module Help!

I know almost nothing about automating Excel, but read this article....

http://www.mvps.org/access/modules/mdl0007.htm

[Br@dley]

Re: Module Help!

jpodesta@ibtco. com wrote:[color=blue]
> I would like to add the xls macros below to the module listed. I am
> looking for advice as to the best way to go about this.[/color]

<>
[color=blue]
> Any advice would be appreciated.[/color]

You'd need to reference Excel (in an Access module go to
Tools/References in the menu).
--
regards,

Bradley

A Christian Response

http://www.pastornet.net.au/response

[Br@dley]

Re: Module Help!

jpodesta@ibtco. com wrote:[color=blue]
> I would like to add the xls macros below to the module listed. I am
> looking for advice as to the best way to go about this.[/color]

<>
[color=blue]
> Any advice would be appreciated.[/color]

You'd need to reference Excel (in an Access module go to
Tools/References in the menu).
--
regards,

Bradley

A Christian Response

http://www.pastornet.net.au/response