Public Sub SendMail()
Dim objAccount As Object
Dim objApp As Object ‘Outlook.Application
‘ If Not CheckData Then
‘ Exit Sub
‘ End If
‘
‘ If MsgBox(shtMessage.Range("A1").Value, vbYesNo + vbExclamation) <> vbYes Then
‘ Exit Sub
‘ End If
Set objApp = GetObject("", "Outlook.Application")
If objApp.Session.accounts.Count > 1 Then
frmAccounts.Show vbModal
If Val(frmAccounts.lstAccounts.Tag) > 0 Then
Set objAccount = objApp.Session.accounts.Item(Val(frmAccounts.lstAccounts.Tag))
Else
Exit Sub
End If
Else
Set objAccount = objApp.Session.accounts.Item(1)
End If
Dim strPath As String
Dim objWB As Workbook
‘strPath = Environ$("TEMP") & "\test.xlsm"
‘ ThisWorkbook.SaveCopyAs strPath
Dim endRow
Dim rowindex As Integer
endRow = Sheet24.Range("a65536").End(xlUp).Row
MsgBox endRow
For rowindex = 1 To endRow
‘判断项目名称是否为空
If Sheet24.Cells(rowindex, 1) = "" Then
Exit For
End If
Dim objMailItem As Object ‘MailItem
Set objMailItem = objApp.CreateItem(0)
objMailItem.To = "[email protected]"
objMailItem.Cc = ""
objMailItem.Subject = "hello world"
objMailItem.Body = "this is a test mail"
objMailItem.Attachments.Add ExcelToWordToPdf(rowindex)
objMailItem.Display
‘objMailItem.Send
Next
‘ Dim objMailItem As Object ‘MailItem
‘
‘ Set objMailItem = objApp.CreateItem(0)
‘
‘ objMailItem.to = "[email protected]"
‘ objMailItem.Cc = ""
‘ objMailItem.Subject = "hello world"
‘ objMailItem.Body = "this is a test mail"
‘ ‘objMailItem.Attachments.Add strPath
‘
‘ objMailItem.Display
‘ ‘objMailItem.Send
‘
‘ MsgBox "Success!", vbInformation
End Sub
Sub TestFunc() ‘定义一个string类型的参数s
Dim s
s = "abc "
MsgBox Len(s)
MsgBox Application.ActiveWorkbook.path
‘ MsgBox ExcelToWordToPdf("我的文件") ‘返回一个字符串"返回值"
End Sub
Function ExcelToWordToPdf(rowindex As Integer)
Dim wdDoc, newPdfPath, currentPath, filename
currentPath = Application.ActiveWorkbook.path & "\"
newPdfPath = currentPath & "files\"
filename = Sheet24.Cells(rowindex, 1) & ".pdf"
Set wdDoc = CreateObject(currentPath & "template.docx") ‘打开word
wdDoc.Range.Find.Execute FindText:="{1}", ReplaceWith:="标题---test-replage", Replace:=1 ‘replace为1 替换一次，2替换所有
wdDoc.Range.Find.Execute FindText:="{2}", ReplaceWith:="test----2"
If Dir(newPdfPath) = "" Then
MkDir (newPdfPath)
End If
wdDoc.ExportAsFixedFormat newPdfPath & filename, 17 ‘ wdExportFormatPDF 是17
wdDoc.Close
Set wdDoc = Nothing
ExcelToWordToPdf = newPdfPath & filename
End Function