It's working by hand, but not in Access VBA code

S

Song

Following code working. But

When I change
Const conWKB_NAME = "S:\Apps\cisLive\data\Census.xltx" and
strFileName = strSubject & ".xlsx"

to
Const conWKB_NAME = "S:\Apps\cisLive\data\Census.xltm"
strFileName = strSubject & ".xlsm"

No file will be created and no error message. I changed above two
lines because I want to add macro in Excel. I can manually open macro
enabled Excel template and save as macro enabled Excel file. But it
does not work in Access VBA code. Does anyone know why?

Thanks.

Song Su

Private Sub cmdBatchRoster_Click()
Dim objExcel As Excel.Application
Dim objXL As Object
Dim objWkb As Object
Dim objSht As Object
Dim fso As Object
Dim Myfile As Object
Dim Bodyfile As String
Dim strInst As String, strSubj As String, strYear As String,
strSect As String
Dim strSem As String, strEmail As String, strFileName As String,
strNo As String
Dim strSubject As String, strPath As String, Emailmsg As String,
strFirst As String

Dim db As Database
Dim rs As Recordset, rs1 As Recordset

strPath = "C:\BatchRoster"

Dim strWhat As String, boolXl As Boolean

DoCmd.SetWarnings False

' If I change this line to .xltm and file name line below to .xlsm, no
file will be created
Const conWKB_NAME = "S:\Apps\cisLive\data\Census.xltx" 'Template
file and location

'Check if Excel is running
If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXl = True
Else
Set objXL = CreateObject("Excel.Application")
boolXl = True
End If

Set db = CurrentDb
Set objExcel = CreateObject("Excel.Application")

Set rs = db.OpenRecordset("tblTmpCourse", dbOpenSnapshot)


Do While Not rs.EOF 'Run through all records in the
tblTmepCourse table

If rs.RecordCount <> 0 Then 'If there is any student enrollment,
keep going

strYear = rs!YYYY ' Year
strSem = rs!SEMESTER ' Semester
strSubj = rs!Subj ' Course Subject
strNo = rs!No ' Course No
strSect = rs!Sect ' Section
strEmail = rs!Email ' email address for the
instructor
strFirst = rs!First 'Instructor's first name
Emailmsg = "Dear " & StrConv(strFirst, 3) & "," & vbNewLine &
vbNewLine & Me.txtContent
strSubject = strYear & " " & strSem & " " & strSubj & " " &
strNo & " - " & strSect

' If I change following line to .xlsm (and template line above
to .xltm), no file will be created.
strFileName = strSubject & ".xlsx"

With objXL
.Visible = False 'Hide Excel
Set objWkb = .Workbooks.Open(conWKB_NAME) 'Open template
file

On Error Resume Next

Set objSht = objWkb.Worksheets("sheet1") 'The step and
the next is important when working with more
'than one
worksheet
objWkb.Worksheets("Sheet1").Activate 'It is
important to set and activate the
objWkb.Windows("Sheet1").Visible = True 'This step is
necessary when you have more than one worksheet in
'the same work
book

Err.Clear

On Error GoTo 0
Set rs1 = Nothing

With objSht
On Error Resume Next

.Range("D1").Value = rs!YYYY & " " & rs!SEMESTER 'Copy
header info
.Range("D2").Value = rs!Subj & " " & rs!No & " - " & rs!
Sect
.Range("D3").Value = rs!Instructor
.Range("D4").Value = rs!Begin

End With
End With

Set rs1 = Nothing

objXL.DisplayAlerts = False
objWkb.SaveAs strPath & "\" & strFileName
objSht.Close
objWkb.Close
Set objSht = Nothing
Set objWkb = Nothing
Set rs1 = Nothing

' Call SendEMail(strEmail, "", strSubject, Emailmsg, strPath &
"\" & strFileName, False)

End If
rs.MoveNext
Loop

objXL.Quit

Set rs = Nothing

Set objXL = Nothing
Set fso = Nothing
Set Myfile = Nothing

DoCmd.SetWarnings True
MsgBox "Done!"

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top