I am running the code below, in Excel, and it works fine, on my personal laptop, to convert a PDF file to a text file.
Sub ConvertPDFtoTextViaWord()
Const filePath As String = "C:\Users\ryans\OneDrive\Desktop\"
Dim file As String, fileName As String
Dim myWord As Word.Application, myDoc As Word.Document
Set myWord = New Word.Application
file = Dir(filePath & "*.pdf")
myWord.DisplayAlerts = wdAlertsNone
Do While file <> ""
fileName = Replace(file, "pdf", "txt")
Set myDoc = myWord.Documents.Open(fileName:=filePath & file, ConfirmConversions:=False, Format:="PDF Files")
myDoc.SaveAs2 filePath & fileName, FileFormat:=wdFormatText, Encoding:=1252, lineending:=wdCRLF
myDoc.Close True
file = Dir
Loop
Set myDoc = Nothing
Set myWord = Nothing
End Sub
However, when I run the same code on my office laptop, it stops on this line:
myDoc.SaveAs2 filePath & fileName, FileFormat:=wdFormatText, Encoding:=1252, lineending:=wdCRLF
When I get to this line on my office laptop, I get this error:
Run time error 91: object variable or with block not set.
Maybe the Set myDoc command is not being set correctly. When I mouse-over myDoc, I see myDoc = Nothing. myDoc SHOULD be the PDF file, but it's not. Any idea what's happening here and how can I fix this? Thanks.
Related
I am testing this code to open a PDF, select everything, copy, and paste special values into Excel.
Sub SelectCopy()
Dim myShell As Object
Set myShell = CreateObject("WScript.Shell")
myShell.Run "C:\Users\rs\Desktop\test.pdf"
SendKeys "^a" 'Select All
SendKeys "^c" 'Copy
SendKeys "%{F4}" 'Close shell application
wkSheet.Range("A1").Select
SendKeys "^v" 'Paste
End Sub
When I get to this line...SendKeys "^a" 'Select All
It selects all the VBA code in the Module.
I tried Data > Import > PDF and it imports four tables from my PDF, but some of the data is getting truncated. If I open the PDF, hit Ctrl+A, then Ctrl+C, and got to Excel and hit Ctrl+V, I get exactly what I want.
I ended up going with this solution.
Sub convertPDFtoTextViaWord()
Const filePath As String = "C:\myfilepath\"
Dim file As String, fileName As String
Dim myWord As Word.Application, myDoc As Word.Document
Set myWord = New Word.Application
file = Dir(filePath & "*.pdf")
myWord.DisplayAlerts = wdAlertsNone
Do While file <> ""
fileName = Replace(file, "pdf", "txt")
Set myDoc = myWord.Documents.Open(fileName:=filePath & file, ConfirmConversions:=False, Format:="PDF Files")
myDoc.SaveAs2 filePath & fileName, FileFormat:=wdFormatText, Encoding:=1252, lineending:=wdCRLF
myDoc.Close False
file = Dir
Loop
Set myDoc = Nothing
Set myWord = Nothing
End Sub
With that little script, I can convert my PDF to a text file, and import the text file into Excel. Done.
Good morning,
I would like to convert the PDF file to Word one (from PDF to DOCX) using Excel macro.
So far I learned the process from this video:
https://www.youtube.com/watch?v=Op25fUfvIl0
and this link:
https://www.pk-anexcelexpert.com/pdf-to-word-converter-macro-in-excel-vba/
but the problem is, that the example is based on the certain cells including the fixed file directory:
pdf_path = sh.Range("E4").Value
word_path = sh.Range("E5").Value
I would like to have always directory the same as my active workbook, which I am working on.
In this event I tried the following code:
Sub Wort_To_PDF()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = True
Dim pdf_path As String
Dim word_path As String
pdf_path = ThisWorkbook.Path & "\"
word_path = ThisWorkbook.Path & "\"
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Set fo = fso.GetFolder(pdf_path)
Dim wa As Object
Dim doc As Object
Set wa = CreateObject("word.application")
wa.Visible = True
Dim file_Count As Integer
For Each f In fo.Files
Application.StatusBar = "Converting - " & file_Count + 1 & "/" & fo.Files.Count
Set doc = wa.Documents.Open(f.Path)
doc.SaveAs2 (word_path & "\" & Replace(f.Name, ".pdf", ".docx"))
doc.Close False
file_Count = file_Count + 1
Next
wa.Quit
MsgBox "All PDF files have been converted in to word", vbInformation
Application.StatusBar = ""
End Sub
I am getting an error "Type mismatch" pointing the following line:
Set fo = fso.GetFolder(pdf_path)
I found some hints regarding the usage of active workbook directory in VBA
How to get the path of current worksheet in VBA?
and tried to put it into my code:
pdf_path = Application.ActiveWorkbook.Path
word_path = Application.ActiveWorkbook.FullName
but the error is exactly the same.
Can anyone help me? I would like to convert the PDF file to docx in the same directory, where my active workbook is stored.
UPDATE:
When I change Dim fo as Folder to Dim fo As Object or Dim fo as Scripting.Folder I am getting another error, informing me, that file is corrupted. Debugger shows the following line:
Set doc = wa.Documents.Open(f.Path)
I think, that problem might be somewhere with my excel document, which is already opened and used. In general, the code executes the first sheet only instead of all of them.
The code could fail because ActiveWorkbook.Path contains something invalid:
If the ActiveWorkbook is a new workbook that was not saved yet, Path is empty - you will get Runtime error 5 (Invalid Argument)
If ActiveWorkbook is on a Sharepoint site or something like that, Path might be an URL - you will get Runtime error 76 (Path not found)
However in your case, it seems that the returned object of the GetFolder-method returns something that is not expected by the VBA runtime. It might be case that you have a type definition Folder somewhere that hides the Folder-type of the Scripting Library. Declare your variable qualified:
Dim fo as Scripting.Folder
Do so for all the other scripting object (f for example)
If you add a reference to the Microsoft Word 16 Object Library, you can also declare the word objects with the correct type, eg
Dim wa as Word.Application
Dim doc as Word.Document
Update: If you loop over all files of the folder, make sure you open only Word files with the Word.Application. Opening some other kind of files will throw errors like the one you see (might be corrupt)
Add a check for the filetype before you open it - you want to convert only word files:
For Each f In fo.Files
if fso.GetExtensionName(f.Name) like "doc*" Then
Set doc = wa.Documents.Open(f.Path)
doc.SaveAs2 (word_path & "\" & Replace(f.Name, ".pdf", ".docx"))
doc.Close False
file_Count = file_Count + 1
End If
Next f
I am trying to write some macros in both Excel and Outlook that in the end will automatically unzip and open a CSV, process the data, and sends it where it needs to go when a new email arrives in a specific folder. I have everything worked out on the Excel side but I am having difficulties with Outlook. The below code unzips the file. How would i go about opening the unzipped file and triggering an Excel macro (which is always open in another workbook)?
Another issue I am running into: this code only seems to work when i actually open the target email in it's own window.
Public Sub OpenZippedSheet()
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim objShell As Object
Dim objFileSystem As Object
Dim strTempFolder As String
Dim strFilePath As String
Dim strFileName As String
Set objMail = Outlook.Application.ActiveInspector.CurrentItem
Set objAttachments = objMail.Attachments
'Save & Unzip the zip file in local drive
Set objShell = CreateObject("Shell.Application")
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp" & Format(Now, "yyyy-mm-dd-hh-mm-ss")
MkDir (strTempFolder)
For Each objAttachment In objAttachments
If Right(objAttachment.FileName, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.FileName
objAttachment.SaveAsFile (strFilePath)
objShell.NameSpace((strTempFolder)).CopyHere objShell.NameSpace((strFilePath)).Items
End If
Next
End Sub
I'm assuming I would do some sort of object.open but I don't know what the syntax would be to get it to actually open in Excel. And then is there a way to trigger an Excel macro from Outlook?
Thanks so much in advance!
this code only seems to work when i actually open the target email in it's own window.
That is because you rely on the ActiveInspector window. If you want to handle items selected in the Explorer windows you need to check the Selection object (see the corresponding property).
To open an Excel file you can:
Use the Shell.ShellExecute method. This method is equivalent to launching one of the commands associated with a file's shortcut menu. Each command is represented by a verb string. The set of supported verbs varies from file to file. The most commonly supported verb is "open", which is also usually the default verb. Other verbs might be supported by only certain types of files.
Automate Excel from your VBA macro to do the required actions. See How to automate Microsoft Excel from Visual Basic for more information.
To run your VBA macro code from other applications you can use the Application.Run method. Read more about that in the How do I use Application.Run in Excel article.
Application.Run "'" & TestWkbk.Name & "'!MacroNameHere", "parm1", "parm2"
Something like this (untested so may need some fixes):
'Note - any paths passed to objShell should be
' passed as *Variants*, not Strings
Dim oXL As Object, wbCSV As Object, fileNameInZip As Variant
Set objShell = CreateObject("Shell.Application")
For Each objAttachment In objAttachments
If Right(objAttachment.Filename, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.Filename
objAttachment.SaveAsFile strFilePath
Set oNS = oApp.Namespace(strFilePath)
For Each fileNameInZip In oNS.items 'loop over the files in the zip
Debug.Print fileNameInZip
If LCase(fileNameInZip) Like "*.csv" Then 'csv file?
'extract the file
objShell.Namespace(strTempFolder).copyhere oNS.items.Item(CStr(fileNameInZip))
If oXL Is Nothing Then Set oXL = GetObject(, "Excel.Application") 'assumes excel is running
Set wbCSV = oXL.Workbooks.Open(strTempFolder & "\" & fileNameInZip)
oXL.Run "'YourMacroFile.xlsm'!YourMacroName" 'run the macro
'clean up stuff...
End If 'is a csv file
Next 'file in zip
End If 'attachment is a zip file
Next 'attachment
I have script that printing specific file, but it's getting hard to make over 150 .vbs files for each document to be printed,
is there any way to have pop-out window where i can type file name, then script find it in folder and print it with 20 copies.
I have PDF, WORD and Excel files
this is what i have now for them
Dim AppExcel
Set AppExcel = CreateObject("Excel.application")
AppExcel.Workbooks.Open"directory\filename.xlsx"
AppExcel.Visible = True
AppExcel.ActiveWindow.SelectedSheets.PrintOut,,20
Appexcel.Quit
Set appExcel = Nothing
filename = "\\MCSERVER01\Data\Forms\Vehicle inspection forms\daily vehicle inspection form.pdf"
Set sh = CreateObject("WScript.Shell")
sh.Run "sumatrapdf.exe -print-to-default """ & filename & """", 0, True
Dim AppWord
Set AppWord = CreateObject("Word.application")
AppWord.Documents.Open"\\MCSERVER01\Data\Forms\DODD\SMALL CAR DRIVERS\Akira Litman.docx"
AppWord.Visible = True
AppWord.ActiveDocument.PrintOut
AppWord.Quit
Set appWord = Nothing
Perhaps you can make use of an input box
Dim fileToPrint As String
fileToPrint = InputBox("Enter file name to print")
I got some help from my old friend, but now i can't get another part working
set fso = CreateObject("Scripting.FileSystemObject")
call main
sub main
InputName = InputBox("ENTER YOUR NAME")
if instr(InputName, ".") = 0 then
msgbox("DON'T NEED THIS AT ALL!!!!!")
exit sub
end if
'msgbox(mid(InputName, instr(InputName, ".")+1))
select case mid(InputName, instr(InputName, ".")+1)
case "xlsx"
call printExcel(InputName)
end select
end sub
sub printExcel(fileName)
Dim AppExcel, path
Set AppExcel = CreateObject("Excel.application")
path = "\MCSERVER01\Data\Forms\Access2Care\WHEELCHAIR DRIVERS\"
if fso.FileExists(path & fileName) then
AppExcel.Workbooks.Open path & fileName
AppExcel.Visible = false
AppExcel.ActiveWindow.SelectedSheets.PrintOut,,20
Appexcel.Quit
Set appExcel = Nothing
else
X=MsgBox ("Wrong File Name Or File Doesn't Exist" ,0+16, "Please Re-Enter Your Full Name")
end if
end sub
so the issue i have now is that i have to type in file extension to make it work otherwise im getting msgbox with "don't need this"
how i can get rid of that msg and just have default extension as xlsx xsl
I receive emails each day which give me a report of my site's performance for the previous day. The reports are given a generic name and I am not able to change this at source. I run the below script via an Outlook rule for whenever a message with certain criteria is received and the report is saved to a given location with yesterday's date in the file name:
Public Sub Save Reports (itm As Outlook.MailItem)
Dim ObjAtt As Outlook.Attachment
Dim SaveFolder As String
For Each ObjAtt In itm.Attachments
If InStr(ObjAtt.DisplayName, ".csv") Then
FileName = (ObjAtt.FileName)
NewName = "System Performance " & Format(Date - 1, "DD-MM-YYYY") & Right(FileName, 4)
SaveFolder = "C:\Users\Me\Documents\"
ObjAtt.SaveAsFile SaveFolder & NewName
End If
Set ObjAtt = Nothing
Next
End Sub
The problem is that if we have any problems anywhere within the process, I might get an email today which actually relates to last week rather than yesterday. If this happens the above script does not work and it requires me to save it manually.
One way I could work round this is if I can work out a way to extract data from a cell in the attached CSV file I am saving and then use that as the file name. For every file I want to save, cell B1 has the date that I need to use in the file name.
I have look through Stackoverflow and other internet resources to try and find something that will allow me to do this but have been unable to work it out.
Thanks to a comment below I have tried to edit my script so saves the files, then opens the files and takes the data needed and then renames the file but to no avail:
Public Sub Save Reports (itm As Outlook.MailItem)
Dim ObjAtt As Outlook.Attachment
Dim SaveFolder As String
Dim xlApp As Object
Dim sourceWB As Excel.Workbook
Dim sourceSH As Excel.Worksheet
Dim strFile As String
For Each ObjAtt In itm.Attachments
If InStr(ObjAtt.DisplayName, ".csv") Then
FileName = (ObjAtt.FileName)
NewName = "System Performance " & Format(Date - 1, "DD-MM-YYYY") & Right(FileName, 4)
SaveFolder = "C:\Users\Me\Documents\"
ObjAtt.SaveAsFile SaveFolder & NewName
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
strFile = SaveFolder & NewName
Set sourceWB = Workbooks.Open(strFile, , False, , , , , , , True)
Set sourceSH = sourceWB.Worksheets("Sheet2")
sourceWB.Activate
Range("B1").Select
newdate = ActiveCell.Value
Set sourceWB = Nothing
Set sourceSH = Nothing
xlApp.Quit
Set xlApp = Nothing
Name SaveFolder & NewName As SaveFolder & newdate
End If
Set ObjAtt = Nothing
Next
End Sub
The Outlook object model doesn't provide any property or method for that. You need to save the attached file on the disk first and then open it for reading the cells. The SaveAsFile method of the Attachment class saves the attachment to the specified path.
Also you can try to read the binary content of the attached file using the low-level API - Extended MAPI. The property name is PR_ATTACH_DATA_BIN which contains binary attachment data typically accessed through the OLE IStream interface. See Opening an Attachment for more information. Also you may consider using any third-party wrappers around that API (for example, Redemption).