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
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