So i want to make a program that print a document as a pdf and send it by email
i have 3 document that i want to print and send
so firstly i make a document and print it like this
Dim PageSetup As New PageSettings
PageSetup.PaperSize = New PaperSize("A4", 827, 1169)
PageSetup.Margins = New Margins(50, 50, 100, 100)
PD_Income_Statement.DefaultPageSettings = PageSetup
With PD_Income_Statement.PrinterSettings
.PrinterName = "Microsoft Print to PDF"
.PrintToFile = True
.PrintFileName = "Reports\IncomeStatement\RPTIS" & Format(Now, "ddMMyy") & ".pdf"
End With
If System.IO.File.Exists("Reports\IncomeStatement\RPTIS" & Format(Now, "ddMMyy") & ".pdf") Then
System.IO.File.Delete("Reports\IncomeStatement\RPTIS" & Format(Now, "ddMMyy") & ".pdf")
End If
If Not System.IO.Directory.Exists("Reports\IncomeStatement") Then
System.IO.Directory.CreateDirectory("Reports\IncomeStatement")
End If
PD_Income_Statement.Print()
this code goes for all 3 document with different name and path
and then i send it with this code
e_mail.Attachments.Add(New Attachment("Reports\DailySales\RPTDS" & Format(Now, "ddMMyy") & ".pdf"))
e_mail.Attachments.Add(New Attachment("Reports\MinimumStock\RPTMS" & Format(Now, "ddMMyy") & ".pdf"))
e_mail.Attachments.Add(New Attachment("Reports\IncomeStatement\RPTIS" & Format(Now, "ddMMyy") & ".pdf"))
smtp_server.UseDefaultCredentials = False
smtp_server.Credentials = New Net.NetworkCredential(My.Settings.Email, My.Settings.EmailPassword)
smtp_server.Port = 587
smtp_server.EnableSsl = True
smtp_server.Host = "smtp.gmail.com"
smtp_server.Send(e_mail)
MsgBox("Sended!")
when i run the print code first, i checked all the document is printed as pdf at the right directory, and when i run the send code it goes swimmingly.
but when i run all the code in once, for some reasons it cannot find the last document.
error message says like 'cannot find file C:........'
then i copy the error url, paste on my browser, and boom! my document is there.
why?
i need help
thanks~
Related
From last week till now, I have a several question here to did the mini project send email with attachment by Excel VBA. Now I'm stucking in the final step.
My project is send email with the proper attachment (stored in the specific folder). something like this:
Here is my code:
Sub SendEmail_Example1()
' email processing
For i = 2 To Sheet2.Range("A" & Rows.Count).End(xlUp).Row
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)
EmailItem.To = Sheet2.Range("D" & i).Value
'EmailItem.CC = "hello#gmail.com"
'EmailItem.BCC = "hhhh#gmail.com"
EmailItem.Subject = "User info of " & Sheet2.Range("D" & i).Value
EmailItem.HTMLBody = "Hi, below is your user info " & "<br>" & "User is: " & Sheet2.Range("B" & i).Value & "<br>" & _
"Password is : " & vbNewLine & Sheet2.Range("C" & i).Value & _
vbNewLine & vbNewLine & _
"<br>" & "Regards," & _
"<br>" & "VT"
'Source = ThisWorkbook.FullName
'---------Attachment
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim file As file
Dim folder As folder
Set folder = fso.GetFolder("C:\test")
'Source = "C:\test"
For Each file In folder.Files
If Sheet1.Range("A" & i).Value = file.Name Then
EmailItem.Attachments.Add file.Name
Exit For
End If
Next file
EmailItem.Send
Next i
End Sub
I would like to grab the proper attachment with each outgoing email, that mean the email send to user named "jack" will get the attach named "jack.xlsx"
Could you please help assist on this issue ? Appriciated much for all the support
There are 2 issues with FSO/Attachment portion of your code:
file.Name will return the file with the extension which will not match the value in your Column A so you need to use fso.GetBaseName to get the file name without the extension.
You need to provide the full path of the file to add attachment so use file.Path instead of file.Name.
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim file As file
Dim folder As folder
Set folder = fso.GetFolder("C:\test")
'Source = "C:\test"
For Each file In folder.Files
If Sheet1.Range("A" & i).Value = fso.GetBaseName(file.Name) Then
EmailItem.Attachments.Add file.Path
Exit For
End If
Next file
EmailItem.Send
I am using an excel vba project to create an word file then saving it to pdf using following code.
wordapp.ActiveDocument.SaveAs2 "" & folder & "" & pdfname & ".pdf", 17
I want to print the same word file using PDF printer at path of
& folder &
and filename as
& pdfname &
I have tried using this as a macro in word file but it asks for a path and filename. Does not automate it.
Probably the easiest way is to use the pdfName as a string and to put a \ sign before it and the folder.
Try to run this code from Excel file, just make sure that the Excel file is saved successfully, otherwise ThisWorkbook.Path would be equl to empty string and you will be asked to save the file during runtime -> If ThisWorkbook.Path = vbNullString Then ThisWorkbook.Save
Public Sub TetMe()
Dim wordApp As Object
Dim WordDoc As Object
Dim folder As String
Dim pdfName As String: pdfName = "someName"
If ThisWorkbook.Path = vbNullString Then ThisWorkbook.Save
Set wordApp = CreateObject("Word.Application")
Set WordDoc = wordApp.documents.Add
folder = ThisWorkbook.Path & "\"
wordApp.ActiveDocument.SaveAs2 folder & pdfName & ".pdf", 17
End Sub
If you are wondering what 17 after .SaveAs2 is, it is wdSaveFormat Enumeration for wdFormatPDF.
WdSaveFormat Enumeration MSDN
Following Code can be used to make Foxit PDF Printer run for your code.
MAIN CODE
ActivePrinter = "Foxit Reader PDF Printer"
printoutcommand = "wordapp.ActiveDocument.PrintOut
Range:=wdPrintAllDocument, PrintToFile:=True,OutputFilename:=" & sItem &
pdfname & "_temp" & ".pdf"
wordapp.Application.Run "FoxitPrint2PDF"
Application.Wait (Now + TimeValue("0:00:02"))
Name "C:\Users\shena\Documents\Document1.pdf" As pdfname & "_temp" & ".pdf"
Application.Wait (Now + TimeValue("0:00:02"))
FileCopy "C:\Users\shena\Documents\" & pdfname & "_temp" & ".pdf", sItem & "" & pdfname & "_temp" & ".pdf"
Application.Wait (Now + TimeValue("0:00:02"))
Kill "C:\Users\shena\Documents\" & pdfname & "_temp" & ".pdf"
Application.Wait (Now + TimeValue("0:00:02"))
wordapp.activedocument.Close SaveChanges:=wdDoNotSaveChanges
wordapp.Quit
Set wordapp = Nothing
FoxitPrint2PDF is macro used to set Foxit PDF Printer as default printer and then reset it. Code is as follows
Dim sCurrentPrinter As String
On Cancel GoTo Cancelled:
sCurrentPrinter = ActivePrinter
ActivePrinter = "Foxit Reader PDF Printer"
Application.PrintOut FileName:=""
Cancelled:
ActivePrinter = sCurrentPrinter
Its just an idea given same code can be written in a module where print operation is going on.
In main code some cut paste operations are seen. Here is the explanation of the same. When we select PDF as a printer we have selected a default location for converted PDF. from that location we are taking it to our desired location. You can see those option at right click on "Foxit Reader PDF Printer" then click on Printing Preferences. Screen shot of the same is given below for reference.
Highlighted options are important for us.
I would like to convert my Word Doc to a pdf and send it as an attachment as part of my constructed Outlook email.
I have tried adding ,".pdf" at the end of my SaveAs2 line, which changed and attached the file format as pdf, however, when attempting to open the file it does not display and gives me a message that the file did not have all it's code when sent as an attachment.
Private Sub emailbutton_Click()
'No-option email sending
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
If VName.Value = "" Then
Doc.SaveAs ("Quotation_Blank 2016")
Else
Doc.SaveAs2 ("QFORM" & "_" & JNumber.Value & "_" & VName.Value)
End If
With EmailItem
.Display
End With
' Signature = EmailItem.body
With EmailItem
.Subject = "QFORM" & "_" & JNumber.Value & "_" & VName.Value
'HTMLbody
msg = "<b><font face=""Times New Roman"" size=""4"" color=""blue"">INTEGRATED ASSEMBLY </font></b><br>" _
& " 1200 Woodruff Rd.<br>" _
& " Suite A12<br>" _
& " Greenville, SC 29607<br><br>" _
& "We have recently released subject project, which will contain assemblies to be outsourced. You have been selected to build these assemblies according to the attachment. <br><br>" _
& "As part of this process, please review the quotation form attached and indicate your acceptance. If adjustments and-or corrections are required, please feel free to contact us for quick resolution. <br><br>" _
& "<b><font face=""Times New Roman"" size=""4"" color=""Red"">NOTE: </font></b>" _
& "The information on attached quotation form is not a contract and only an estimate of predetermined costs per hourly rate for outsource assemblies. <br><br>" _
& "*******For your records you may wish to print out the completed quote form. <br><br>" _
& "Thank you, <br><br>" _
& "<b>HARTNESS INTERNATIONAL </b><br>" _
& "H1 Production Control <br>" _
& vbNewLine & Signature
.HTMLBody = msg & .HTMLBody
If VName.Value = "INTEGRATED ASSEMBLY" Then
.To = "Email1.com;"
.CC = "Email2.com;" & "Email3.com;"
.Importance = olImportanceNormal 'Or olImportanceHigh Or olImportanceLow
.Attachments.Add Doc.FullName
.Display
ElseIf VName.Value = "LEWALLEN" Then
.To = "Email1.com;"
.CC = "Email2.com;" & "Email3.com;"
.Importance = olImportanceNormal 'Or olImportanceHigh Or olImportanceLow
.Attachments.Add Doc.FullName
.Display
End If
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
With SaveAs2 you can specify FileFormat
https://msdn.microsoft.com/en-us/library/office/ff836084.aspx
expression .SaveAs2(FileName, FileFormat, LockComments, Password, AddToRecentFiles, WritePassword, ReadOnlyRecommended, EmbedTrueTypeFonts, SaveNativePictureFormat, SaveFormsData, SaveAsAOCELetter, Encoding, InsertLineBreaks, AllowSubstitutions, LineEnding, AddBiDiMarks, CompatibilityMode)
https://msdn.microsoft.com/en-us/library/office/ff839952.aspx
FileFormat is wdFormatPDF or 17
Change your saveAs2 this way.
If VName.Value = "" Then
Doc.SaveAs ("Quotation_Blank 2016")
Else
Doc.ExportAsFixedFormat OutputFileName:="QFORM" & "_" & JNumber.Value , _
ExportFormat:=wdExportFormatPDF
End If
Edit
To use path & add is as attachment
If VName.Value = "" Then
Doc.SaveAs ("Quotation_Blank 2016")
Else
Path = "C:\Temp\"
FileName = "QFORM" & "_" & JNumber.Value & "_" & VName.Value
Doc.ExportAsFixedFormat OutputFileName:=Path & FileName, _
ExportFormat:=wdExportFormatPDF
End If
And Attahcment
.Attachments.Add Path & FileName & ".pdf"
If you need to convert multiple Word files to other formats, like TXT, RTF, HTML or PDF, run the script below.
Option Explicit On
Sub ChangeDocsToTxtOrRTFOrHTML()
'with export to PDF in Word 2007
Dim fs As Object
Dim oFolder As Object
Dim tFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim intPos As Integer
Dim locFolder As String
Dim fileType As String
On Error Resume Next
locFolder = InputBox("Enter the folder path to DOCs", "File Conversion", "C:\Users\your_path_here\")
Select Case Application.Version
Case Is < 12
Do
fileType = UCase(InputBox("Change DOC to TXT, RTF, HTML", "File Conversion", "TXT"))
Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML")
Case Is >= 12
Do
fileType = UCase(InputBox("Change DOC to TXT, RTF, HTML or PDF(2007+ only)", "File Conversion", "TXT"))
Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML" Or fileType = "PDF")
End Select
Application.ScreenUpdating = False
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(locFolder)
Set tFolder = fs.CreateFolder(locFolder & "Converted")
Set tFolder = fs.GetFolder(locFolder & "Converted")
For Each oFile In oFolder.Files
Dim d As Document
Set d = Application.Documents.Open(oFile.Path)
strDocName = ActiveDocument.Name
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
ChangeFileOpenDirectory tFolder
Select Case fileType
Case Is = "TXT"
strDocName = strDocName & ".txt"
ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatText
Case Is = "RTF"
strDocName = strDocName & ".rtf"
ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatRTF
Case Is = "HTML"
strDocName = strDocName & ".html"
ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatFilteredHTML
Case Is = "PDF"
strDocName = strDocName & ".pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName:=strDocName, ExportFormat:=wdExportFormatPDF
End Select
d.Close
ChangeFileOpenDirectory oFolder
Next oFile
Application.ScreenUpdating = True
End Sub
The results are saved in a folder that is dynamically created and in the same folder that contains the documents that you just converted.
I was wondering if you could post all your code for this solution. I have been looking for something like this for a while and all my experience is on powershell. I know this i generally frowned upon but i am running out of options
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
I have a task to convert several hundred PDF documents to HTML format. I have tried multiple standalone converters, but they have problems with handling columns and hyphen justification.
However, if I just open a document in MS Word, it handles them perfectly.
So, basically, I need a way to automate opening PDF in Word, waiting for it to process and saving it as HTML (filtered).
Does somebody knows, how can I do it?
We can do it in PowerShell.
Break your requirement in two pieces
FIRST - Convert PDF to WORD Document
'**** The script runs in a loop until it detects a new file in the directory
'**** It checks the source folder every 30 seconds. To change this interval
'**** change the sleep time at the end of the program to the number of seconds x 1000
'**** wscript.sleep (15000) would check the folder every 15 seconds
'****
'****
'**** The program uses AnyBizSoft PDtoWord converter. It is available as a free version off of
'*** facebook here - Facebook - http://www.facebook.com/AnyBizSoft?v=app_6009294086
'*** You can buy it from thier website at http://www.anypdftools.com/pdf-to-word.html
'*** I have no connection with them other than they were the first one i found that worked with
'*** a command line.
'***
'*** The script uses two directories. C:\Source\ is where pdf files are copied to
'*** C:\Converted is where the converted file is placed. It is either a doc file if you have Office 2003 or
'*** older or a docx if you have Office 2007 or newer.
'*** After the file is converted the original pdf is deleted. This can be changed by commenting out the
'*** Line that deletes the file near the end of the script.
'***
'*** The script can be placed anywhere, but the pdftoword folder needs to be copied from the program files
'*** directory to the c:\source folder
'***
'Option Explicit
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strComputer
strComputer = "."
spath="C:\source\" '*** Source directory
dpath="C:\converted\" '*** Destination or Converted Directory
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN 10 WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""c:\\\\source""'")
Do
Do
set sourcefolder=objFso.GetFolder(spath)
numfiles=sourcefolder.files.count
set sourcefiles = sourcefolder.files
for each objFile in sourcefiles
sourcefile = objFile.name
next
loop until (numfiles > 0)
'*** Call pdftoword to convert the file
Set wshShell = WScript.CreateObject ("WSCript.shell")
convertstr="c:\source\pdftoword\pdftoword.exe " & chr(34) & spath & sourcefile & chr(34)
wshshell.run convertstr, 6, false
Do '*** Wait for docx to be created before continuing
Set objLatestEvent = colMonitoredEvents.NextEvent
loop until (instr(objLatestEvent.TargetInstance.PartComponent,"doc") > 0)
'*** Make time stamp for file name
d = Now
hhmmss = Right("00" & Hour(d), 2) & Right("00" & Minute(d), 2) & Right("00" & Second(d), 2)
'*** Get just the filename without the extension
sourcefilename = left(sourcefile,instr(sourcefile,".")-1)
'*** Add the timestamp to the converted file
newname = sourcefilename & "-" & hhmmss
'*** Exit program if file exists in the destination folder. Highly unlikely since it is timestamped
if objfso.FileExists(dpath & newname & ".docx") then
wscript.echo "Destination file " & dpath & newname & ".docx exists already"
WScript.Quit
end if
if objfso.FileExists("c:\converted\" & newname & ".doc") then
wscript.echo "Destination file " & dpath & newname & ".doc exists already"
WScript.Quit
end if
'*** move converted file to the converted folder then delete original
if objfso.FileExists(spath & sourcefilename & ".docx") then
newname= dpath & newname & ".docx"
oldname = spath & sourcefilename & ".docx"
objfso.Movefile "" & oldname & "", "" & newname & ""
objfso.DeleteFile("" & spath & sourcefile & "") 'Delete or comment this line if you do not want the original deleted
end if
if objfso.FileExists(spath & sourcefilename & ".doc") then
newname= dpath & newname & ".doc"
oldname = spath & sourcefilename & ".doc"
objfso.Movefile "" & oldname & "", "" & newname & ""
objfso.DeleteFile("" & spath & sourcefile & "") 'Delete or comment this line if you do not want the original deleted
end if
' *** Kill PDFtoword process
strProcessKill="PDFtoWord.exe"
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'PDFtoWord.exe'" )
For Each objProcess in colProcess
objProcess.Terminate()
Next
wscript.sleep (30000) 'Wait 30 seconds to look for next file. 1000 = 1 second
Loop
SECOND - Convert WORD Documents TO HTML
param([string]$docpath,[string]$htmlpath = $docpath)
$srcfiles = Get-ChildItem $docPath -filter "*.doc"
$saveFormat = [Enum]::Parse([Microsoft.Office.Interop.Word.WdSaveFormat], "wdFormatFilteredHTML");
$word = new-object -comobject word.application
$word.Visible = $False
function saveas-filteredhtml
{
$opendoc = $word.documents.open($doc.FullName);
$opendoc.saveas([ref]"$htmlpath\$doc.fullname.html", [ref]$saveFormat);
$opendoc.close();
}
ForEach ($doc in $srcfiles)
{
Write-Host "Processing :" $doc.FullName
saveas-filteredhtml
$doc = $null
}
$word.quit();
Save this code to convertdoc-tohtml.ps1 and you can run it on a set of word documents regardless of doc or docx extension.
Here’s how you can run it:
convertdoc-tohtml.ps1 -docpath "C:\Documents" -htmlpath "C:\Output"
What I am trying to do is copy a chart from excel into an outlook email, but after numerous searching I am struggling.
i am having trouble positioning where the chart is pasted. I want it to paste after the last line "this is another line again " in the body of the email. It currently pastes at the start of the email before the line "test ... body"
Sub CopyAndPasteToMailBody3() ' this works but how do i control where it puts the chart?
Set mailApp = CreateObject("Outlook.Application")
Set mail = mailApp.CreateItem(olMailItem)
mail.Display
mail.To = "A#a.com"
mail.subject = "subject" & Now
mail.body = "test ... body" & vbNewLine & vbNewLine _
& "this is another line " & vbCrLf _
& "this is another line again "
Set wEditor = mailApp.ActiveInspector.wordEditor
ActiveChart.ChartArea.Copy ' chart needs to be active
wEditor.Application.Selection.Paste
' mail.send
End Sub
Note: using excel 10 on windows 7
I have found that
Set wEditor = mailapp.ActiveInspector.WordEditor
needs to be followed by
wEditor.Range(0, 0).Select
to avoid an error sometimes when you go to paste it.
You can modify the code put the Body on the Clipboard and Paste it:
Set mailApp = CreateObject("Outlook.Application")
Set mail = mailApp.CreateItem(olMailItem)
mail.Display
mail.To = "A#a.com"
mail.Subject = "subject" & Now
Dim Clip As MSForms.DataObject
Set Clip = New MSForms.DataObject
Clip.SetText ("test ... body" & vbNewLine & vbNewLine _
& "this is another line " & vbCrLf _
& "this is another line again " & vbNewLine & " ")
Clip.PutInClipboard
Set wEditor = mailApp.ActiveInspector.wordEditor
wEditor.Application.Selection.Paste
ActiveChart.ChartArea.Copy ' chart needs to be active
wEditor.Application.Selection.Paste
' mail.send
In this case you can assembly the mail as you want.
MSForms.DataObject need to have the Reference: Microsoft Form 2.0 Object Library (FM20.DLL)
You can try also with another code (in this case the image are temporary saved on disk):
Sub CopyAndPasteToMailBody4() ' this works but how do i control where it puts the chart?
Set mailApp = CreateObject("Outlook.Application")
Set mail = mailApp.CreateItem(0)
mail.Display
mail.To = "A#a.com"
mail.Subject = "subject" & Now
Dim Stri As String
Stri = "test ... body" & vbNewLine & vbNewLine _
& "this is another line " & vbCrLf _
& "this is another line again " & vbNewLine & " "
ActiveChart.Export "e:\0\C1.png"
Stri = Stri & "<img src='e:\0\C1.png'>"
mail.HTMLBody = Stri
' mail.send
End Sub
On my PC the first code ask me some permission, with the second code no...