I want to save an email as a Word file through a macro, and then replace this with a converted PDF file via Word. The conversion part is working fine - the issue is when I try to delete the original .doc file.
Dim objWrd As Object
Dim objWrdDoc As Object
Dim wrdCurrentPrinter As String
Set objWrd = CreateObject("Word.Application")
Set objWrdDoc = objWrd.Documents.Open(filePath & fileName)
''Print' file as PDF - current printer is stored so it can be reverted back afterwards
wrdCurrentPrinter = objWrd.ActivePrinter
objWrd.ActivePrinter = "Microsoft Print To PDF"
'File name is specified here to avoid Save As prompt. PrintToFile property is 'True'
objWrd.PrintOut , , , filePath & Replace(fileName, ".doc", ".pdf"), , , , , , , True
objWrd.ActivePrinter = wrdCurrentPrinter
objWrd.Quit
Set objWrd = Nothing
Kill filePath & fileName
At Kill filePath & fileName I get error 70 - Permission denied.
I am able to delete the file manually without any problems, and if I add a breakpoint and step through the 'Kill' line, it works when there is even a slight delay between Word closing and the Kill command. Therefore I suspect that the code is being processed so quickly so that the file is still open at the time of running the command.
I have a feeling I may need to go down the route of creating a delay, which I have been having trouble with in Outlook. Is this the likely solution or is there something else that I have missed?
I have been able to get this to work consistently by simply closing the Word document before quitting Word altogether:
objWrdDoc.Close
objWrd.Quit
Set objWrd = Nothing
The error has not appeared since adding this line and testing with various emails.
Related
Scenario
I have an excel file that contains data. There are multiple users accessing the file at the same time.
Problem
There will be problem if multiple users tried to input data to that excel file at the same time due to only one user is allowed to open the file at one time
Question
Is there any way whereby I can update the excel file (Eg: add a value to a cell, delete a value from a cell, find a particular cell etc) without opening it so that multiple users can update it at the same time using excel VBA?
I went to the direction of using shared files. But later found out to be excel shared files are very buggy. If use shared file, excel/macro can be very slow, intermittent crashes and sometime the whole file may get corrupted and could not be opened or repaired afterwards. Also depends on how many users use the file, the file size can grow quite big. So it is best not to use shared workbook. Totally not worth trying. Instead if need multiple users to update data simultaneously, it is better to use some database such as MSAccess, MSSql (Update MSSQL from Excel) etc with excel. For my situation since number of users are less, I didn't use any database, instead put a prompt for the user to wait until the other user close that file. Please see the codes below to check if a file is opened and if so, to prompt user. I got this code from stack overflow itself and I modified to suit my needs.
Call the module TestFileOpened as below.
Sub fileCheck()
Call TestFileOpened(plannerFilePathTemp)
If fileInUse = True Then
Application.ScreenUpdating = True
Exit Sub
End If
End Sub
Here plannerFilePathTemp is the temporary file location of your original file. Whenever an excel file opened, a temp file will be created. For example, your original file location is as below
plannerFilePath = "C:\TEMP\XXX\xxx.xlsx"
Thus your temporary file location will be
plannerFilePathTemp = "C:\TEMP\XXX\~$xxx.xlsx"
or in other words, temporary file name will be ~$xxx.xlsx
The following codes will be called upon Call TestFileOpened(plannerFilePathTemp)
Public fileInUse As Boolean
Sub TestFileOpened(fileOpenedOrNot As String)
Dim Folder As String
Dim FName As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(fileOpenedOrNot) Then
fileInUse = True
MsgBox "Database is opened and using by " & GetFileOwner(fileOpenedOrNot) & ". Please wait a few second and click again", vbInformation, "Database in Use"
Else
fileInUse = False
End If
End Sub
Function GetFileOwner(strFileName)
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
GetFileOwner = objSD.Owner.Name
Else
GetFileOwner = "Unknown"
End If
End Function
I encountered Out of memory issues also when used shared files. So during the process, I figured out the following methods to minimize memory consumption
Some tips to clear memory
It is easy to save emails in Outlook VBA with MailItem.SaveAs
But I don't see any option to save additional details like i.e. the Author and Categories.
The 3rd party program MessageSave allows to save mails with Categories and Author in .msg format. In Windows Explorer the columns Author and Categories show the same information like in Outlook.
Does anybody know how to save messages using Outlook VBA including these additional information?
I bought MessageSave and it's a good program but they don't allow their save function to be used in VBA. The only workaround is to let MessageSave save messages when they "arrive" in a specific folder. If necessary I can use this function but this is just a workaround.
Here is a sample how the emails saved with MessageSave are shown in Windows Explorer:
here is a process i followed: (win7 64)
web search "windows vba set extended file property"
first hit: StackOverfow 16989882
web search: "DSOFile.OleDocumentProperties"
hit microsoft: The Dsofile.dll files lets you edit Office document properties when you do not have Office installed
https://support.microsoft.com/en-us/help/224351/the-dsofile.dll-files-lets-you-edit-office-document-properties-when-yo
that is not a typo ... it ends in "when-yo"
download: DsoFileSetup_KB224351_x86.exe
open DsoFileSetup_KB224351_x86.exe using 7-zip program (from 7-zip.org)
copy dsofile.dll from DsoFileSetup_KB224351_x86.exe (using 7-zip) into a folder desktop (named "testFiles" in this example) (this could be anywhere ... maybe windows system32 or syswow64 ... i only tried on desktop )
open command prompt window as administrator
navigate to folder that contains dsofile.dll
execute following: regsvr32 dsofile.dll
should receive success confirmation
start outlook ... vba editor ... tools ... references
and find "DSO OLE Document Properties Reader 2.1" and check the box on left
back to vba editor ... create new module
paste in the following: (this is just a minimal test script)
Sub extendedProperties()
Dim objFile As OleDocumentProperties
Set objFile = CreateObject("DSOFile.OleDocumentProperties")
objFile.Open ("C:\Users\js\Desktop\testFiles\myMessage.msg") ' adjust to match your system
objFile.SummaryProperties.Subject = "My Subject"
objFile.Save
Set objFile = Nothing
End Sub
copy (drag&drop) an email "myMessage" from outlook to folder (on desktop in this example)
right-click on folder column header ... click on more ... find "subject" ...
click checkbox
ran script
subject column should contain "My Subject" next to myMessage.msg (or whatever your message is named)
there may be a simpler way ... maybe windows PowerShell has a command that could be called from vba
here is a more usable script
it has no error checking
no check for duplicate message names
no check for illegal filenames (except for ":" character)
just select a bunch of emails in any outlook folder and run this
' make sure you have a reference to "DSO OLE Document Properties Reader"
Sub extendedProperties()
Dim msg As mailItem
Dim objFile As OleDocumentProperties
' Set objFile = CreateObject("DSOFile.OleDocumentProperties")
Set objFile = New OleDocumentProperties
Dim fileName As String
Dim subjectText As String
' !!!!!!!! select a bunch of messages before running this !!!!!!!!
For Each msg In ActiveExplorer.Selection
subjectText = Replace(msg.Subject, ":", "_") ' get rid of illegal file name character (there are others)
' adjust the destination folder for your liking
fileName = "C:\Users\js\Desktop\testFiles\" & subjectText & ".msg"
Debug.Print fileName
msg.SaveAs fileName
objFile.Open fileName
objFile.SummaryProperties.Subject = "My Subject"
'objFile.Save
objFile.Close True ' save and close !!!!! duplicate filenames get overwritten !!!!!
' stop ' uncomment this line and the code will stop. press F5 to run, F8 to single-step
Next msg
Set msg = Nothing
Set objFile = Nothing
End Sub
I am trying to create a dashboard in excel using VBA. This is what i am trying to do :
Create a temporary word file in a specified directory.
Populate this temporary word document with charts and tables from the excel.
Mail the document to a person specified in the excel.
Delete the temporary word file.
So, When i started to code, I used the below statement to open a word document from a directory.
Set objDoc = objWord.Documents.Open(Cells(4, 6) + “Temp.docx”)
*Cells(4,6) has the file path
This works, if the file "Temp.docx" is already present in the directory.
What If i want to create a new file "Temp.Docx" if it is not present in the specified directory?
Give this a try:
On Error Resume Next 'allow code to continue even if there's an error
Set objDoc = objWord.Documents.Open(Cells(4, 6) + “Temp.docx”)
if err.number > 0 'check to see if there's an error
'if there was an error opening the document, create a new one instead
Set objDoc = objWord.Documents.Add(Cells(4, 6) + “Temp.docx”)
end if
on error goto 0 'reset error handling to stop on error
You'll probably want to put better error handling in for your entire code, but this little block should take care of your particular question.
You may also want to confirm that cells(4,6) ends with a \, or your path\filename won't be correct. You can do that with:
if right(cells(4,6),1) <> "\" then
cells(4,6) = Cells(4,6) & "\"
end if
Then you can execute the first block of code knowing that you have the proper delimiter in place
I use at the moment the following command to open a set of workbooks one by one:
Workbooks.Open Filename:=fFile, Password:="", UpdateLinks:=xlUpdateLinksNever, ReadOnly:=False
Normally the files are open in write-enabled mode, which is what I want. But for some files, the previous line pops up the following window:
In this case, I need to press Read Only to open it. Even though it is read-only, it is still good to be able to open it.
So to conclude, I try to open files in write-enabled mode, if it is not possible for some files, opening them in read-only is still fine. But as the number of the files is huge, I really want to automatize it, and avoid this pop-up. Could anyone tell me how to do it?
One possible turnaround is to first opening all the files in read-only mode, then convert them to write-enabled mode if possible. Do you think that is doable?
This is possible workaround for you. The idea is to pass any incorrect password to WriteResPassword argument. If file is protected the error will be thrown. If so you will be able to identify that file and open it in read-only mode. Alternatively, password will be ignored for other files and fill will be open for read-write mode.
Some additional comments within code below.
Sub PossibleWorkaround()
Dim Pass As String
'any password
Pass = "blahblah"
'file which is write-protected will throw error during opening it _
with incorrect password
On Error Resume Next
Workbooks.Open "c:\users\alpha\desktop\filename.xlsx", , , , , Pass
If Err.Number = 1004 Then
'if so, try to open it in read-only mode
Workbooks.Open "c:\users\alpha\desktop\filename.xlsx", , True
End If
'return to standard error handling or set as expected
On Error GoTo 0
'the same for file which is not write-protected
'incorrect password will be ignored
On Error Resume Next
Workbooks.Open "c:\users\alpha\desktop\filename A.xlsx", , , , , Pass
If Err.Number = 1004 Then
'therefore this if statement will not be called
Workbooks.Open "c:\users\alpha\desktop\filename.xlsx", , True
End If
On Error GoTo 0
End Sub
I had the same problem. I tired to find the answer on many formums and nothing. Finally I added WriteResPassword:="password here" in the end of the Worksbooks.Open statement and it did not prompt for a password anymore
Workbooks.Open Filename:="\path to the file\File_name.xlsm", Password:="password here", WriteResPassword:="password here"
I'm working on an application which automatically generates faxes.
The system uses word interop to fill a template .doc file with values (which works fine), but when it comes to be time to print the resulting file to pcl, I'm having issues.
So, we've got a HP Laserjet printer set up which prints .pcl files.
Dim appWord As New Word.Application
Dim doc As New Word.Document
appWord.ActivePrinter = PCL_PRINTER
doc = appWord.Documents.Open(APPLICATION_DIR & "LTL_" & n.Language & ".doc")
... (Fill the file with values)
outFile = APPLICATION_DIR & "Faxout\DROPDIR\" & n.Order & ".pcl"
doc.PrintOut(True, True, , outFile, , , , , , , True)
'cleanup...
Problem is that when the doc.PrintOut line runs, word complains, popping up a message:
I've tried all sorts of combinations of things, but the error message persists. Very occasionally, the thing actually works and generates a usable pcl file, but 98% of the time, the error message pops up and the whole process grinds to a halt.
We have other applications on the same server which do almost exactly the same thing, except they print from excel instead of word, and they work without throwing the error.
Can anyone help?
Don't know if this helps, but do you have an antivirus software on that machine? If so, did you try to disable it? There are sometimes issues with virus scanners accessing files in background, blocking access or deletion of temporary files.
I just figured it out. Apparently you have to create the file before you attempt to write to it.
eg:
Dim fs As FileStream
fs = System.IO.File.Create(outFile)
fs.Close()
fs = Nothing
doc.PrintOut(True, True, , outFile, , , , , , , True)
I'd tried creating the file earlier, but didn't realize that Create returned a filestream which needed to be closed before word would print out to it.
Is there any way to create a file in vb.net that doesn't create a lock on a file with a filestream object? This version works, but it'd be nice to clean up the code a bit.