Open a PDF, select all text, copy, and paste special values - excel

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.

Related

How to get Excel to Have Word Convert PDF to Text?

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.

Problems with Worksheetfunction.Match in a closed workbook. Cannot work out why no match is found

I'm writing a code to delete a log entry in a .csv file. The code starts with opening the .csv file, using Application.Match to return the row number, and then deleting that and closing the file again. The problems I'm experiencing are I get a type mismatch (my error handling is activated) OR (and here it gets weird) it works (a match is found, the row is deleted) but then the logfile is messed up - all data is one string in column a with either ";" or "," delimiters (this varies somehow, relevant note: I use Dutch language excel). Of course, this makes it impossible for the macro to find a match in any case.
I found that the type mismatch problems I'm experiencing will most likely be caused by the code not finding a match, and this is what I don't understand since I checked and doublechecked the input and the data in the logfile - by all means it simply should find a match. And sometimes it does find a match, deletes the row and messes up formatting. (NOTE: Mostly it does NOT find a match.)
I check data in the .csv file before running the macro. I have tried running the macro with the .csv file already opened. I have tried to Set the matchArray from outside the With. I have tried both sweet talking my laptop and a more aggressive approach, to no avail.
Sub DeleteRowFromFile(ByVal matchValue As String)
Dim filePath As String
Dim fileName As String
Dim fileType As String
Dim matchArray As Range
Dim rowToDelete As Variant
'Naming variables for flexibility
filePath = "C:\Users\Maxim\Documents\Log\"
fileName = "TestRegister"
fileType = ".csv"
Application.ScreenUpdating = False
Workbooks.Open (filePath & fileName & fileType)
With Workbooks(fileName).Worksheets(1)
Set matchArray = .Range("A:A") 'set range in the logfile
'Type mismatch here:
rowToDelete = Application.Match(matchValue, matchArray, 0)
If Not IsError(rowToDelete) Then
Rows(rowToDelete).Delete
Else:
MsgBox "Orderno. " & matchValue & " not found.", vbOKOnly + vbExclamation, "Error"
End If
End With
'Closing the log file
Workbooks(fileName).Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Sub MatchAndDelete()
Dim matchValueRange As String
matchValueRange = ActiveWorkbook.Worksheets(1).Range("A1").Value
DeleteRowFromFile (matchValueRange)
End Sub
Footnote:
I'm a struggling enthusiast, I have a lot to learn. Sorry in advance if I have left out any crucial information for you to be of help, and thanks a lot for any and all help.
When you open or save a csv file using a VBA macro Excel will always use the standard (US English delimiters) while if you do the same via the user interface it will use the separators as defined in the Windows regional settings, which probably is ";" in your case.
You can check with .?application.International(xlListSeparator) in the immediate window of your VBEditor.
You can tell Excel to use a different separator, by e.g. adding sep=; as line 1 of your file. Hoever this entry is gone after opening the file. The following code - added before you open the csv file will add this:
Dim oFSo As Object
Dim oTxtFile As Object
Dim strData As String
Set oFSo = CreateObject("Scripting.FileSystemObject")
strData = oFSo.OpenTextFile(filePath & fileName & fileType, 1).ReadAll
Set oTxtFile = oFSo.OpenTextFile(filePath & fileName & fileType, 2)
oTxtFile.writeline "sep=;"
oTxtFile.writeline strData
oTxtFile.Close
You can save your changed file by using the Excel UserInterface Shortcuts via the Application.SendKeys thus achieving what you want:
Application.SendKeys ("^s") 'Save
Application.SendKeys ("^{F4}") 'Close
Dont run this code from the VBE Immeditate window as it will probabaly act on the wrong file!
The full code - just with an alternate way to make the requested change:
Sub DeleteRowFromFile(ByVal matchValue As String)
Dim filePath As String
Dim fileName As String
Dim fileType As String
Dim matchArray As Range
Dim rowToDelete As Variant
Dim oFSo As Object
Dim oTxtFile As Object
Dim strData As String
Dim content As Variant
Dim i As Long
'Naming variables for flexibility
filePath = "C:\Users\Maxim\Documents\Log\"
fileName = "TestRegister"
fileType = ".csv"
Application.ScreenUpdating = False
'Adding "sep =" ; as line 1 of the log file
Set oFSo = CreateObject("Scripting.FileSystemObject")
strData = oFSo.OpenTextFile(filePath & fileName & fileType, 1).ReadAll
Set oTxtFile = oFSo.OpenTextFile(filePath & fileName & fileType, 2)
oTxtFile.writeline "sep=;"
oTxtFile.writeline strData
oTxtFile.Close
'Open logfile
Workbooks.Open (filePath & fileName & fileType)
'Make your changes
With Workbooks(fileName).Worksheets(1)
content = .UsedRange.Value
For i = UBound(content, 1) To 1 Step -1
If content(i, 1) = matchValue Then
.Rows(i).Delete
End If
Next i
End With
'Closing the log file via Sendkeys using excel shortcuts
Application.SendKeys ("^s") 'Save
Application.SendKeys ("^{F4}") 'Close
Application.ScreenUpdating = True
I think that Match it is not required. Try this one.
Sub DeleteRowFromFile(ByVal matchValue As String)
Dim filePath As String
Dim fileName As String
Dim fileType As String
Dim matchArray As Range
Dim rowToDelete As Variant
'Naming variables for flexibility
filePath = "C:\Users\Maxim\Documents\Log\"
fileName = "TestRegister"
fileType = ".csv"
Application.ScreenUpdating = False
Workbooks.Open (filePath & fileName & fileType)
With Workbooks(fileName).Worksheets(1)
For i = .UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If .Cells(i, 1).Value2 = matchValue Then
.Cells(i, 1).EntireRow.Delete
End If
Next
End With
'Closing the log file
Workbooks(fileName & fileType).SaveAs Filename:= _
(filePath & fileName & fileType) _
, FileFormat:=xlCSVMSDOS, CreateBackup:=False 'Saving the file
Workbooks(fileName & fileType).Close 'Closing the file
Application.ScreenUpdating = True
End Sub
Hope it helps

VBA code executes but only if I step thru it

I used some code from Close an opened PDF after opening it using FollowHyperlink to create the following code to open a pdf file and rename it. The code runs fine but only if I break execution at MsgBox "Break Here" and step into it with the F8 key. Any ideas on why it won't execute automatically?
Sub OpenPDF()
'Opens PDF Scaned file & saves it to another folder
'***ErrorHandler***
On Error Resume Next
'***Declare Objects****
Dim objectWMI As Object
Dim objectProcess As Object
Dim objectProcesses As Object
Dim Path As String
Dim MyDir As String
'***Opens a new workbook if there are no active workbooks***
'***There must be an active workbook for FollowHyperlink to function***
nowbs = Application.Workbooks.Count
If nowbs = 1 Then
Application.Workbooks.Add
Else
End If
'***Saves current Excel path
MyDir = CurDir
'***Sets path to Ricoh Scans
PDFDir = "S:\Ricoh Scans"
ChDir PDFDir
'***Gets filename for PDF scan
Path = Application.GetOpenFilename(filefilter:="PDF file (*.pdf), *.pdf")
'***Opens PDF file***
ActiveWorkbook.FollowHyperlink Path
'***Sets Excel as active application
AppActivate "Microsoft Excel"
'***Prompts for PO number****
MyPONum = InputBox("Enter PO Number", "PO Editor", "30500")
'***If user selects Cancel on inputbox then xl closes Acrobat and exits sub
If MyPONum = vbNullString Then
GoTo EndAll
Else
End If
'***Replaces scanned filename with inputbox filename
PathLen = Len(Path)
OldName = Mid(Path, 16, PathLen - 19)
NewName = "S:\Materials Management\Purchase Orders\PO " & MyPONum & ".pdf"
EndAll:
'***Set Objects***
Set objectWMI = GetObject("winmgmts://.")
Set objectProcesses = objectWMI.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'Acrobat.exe'") '< Change if you need be ** Was AcroRd32.exe**
'
'
'Code executes fine up to here but must Ctrl + Break at this line
'and F8 step thru balance of code or it will not work
'
'
MsgBox "Break Here"
'***Terminate all Open PDFs***
For Each objectProcess In objectProcesses
Call objectProcess.Terminate
Next
'***Clean Up***
Set objectProcesses = Nothing
Set objectWMI = Nothing
'***Renames scanned file and moves it to Materials Management folder***
Name Path As NewName
'***Resets current directory
ChDir MyDir
End Sub
Thanks to all for your input. I'm not a programmer and as I said I used code that had been posted elsewhere on this site. It was a timing issue and this edit works.
'***Terminate all Open PDFs***
For Each objectProcess In objectProcesses
objectProcess.Terminate
Next
'***Clean Up***
Set objectProcesses = Nothing
Set objectWMI = Nothing
'***************
Application.Wait (Now + TimeValue("00:00:02"))
'***Renames scanned file and moves it to Materials Management folder***
Name Path As NewName
'***Resets current directory
ChDir MyDir
End Sub

Copying data from multiple pdf files

I have pdf files from which I would like to copy all the data to a column in a spreadsheet.
Here is the code I have. All it does is open the pdf, use control-a, then control-c to copy then activates the workbook, finds an open column and pastes the data with a control-v Sendkey.
I have a range with path names it opens and copies data from all but only pastes the last one.
Sub StartAdobe1()
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
Dim fname As Variant
Dim iRow As Integer
Dim Filename As String
For Each fname In Range("path")
AdobeApp = "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe"
StartAdobe = Shell("" & AdobeApp & " " & fname & "", 1)
Application.Wait Now + TimeValue("00:00:01")
SendKeys "^a", True
Application.Wait Now + TimeValue("00:00:01")
SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
SendKeys ("%{F4}")
Windows("transfer (Autosaved).xlsm").Activate
Worksheets("new").Activate
ActiveSheet.Range("A1").Select
Selection.End(xlToRight).Offset(0, 1).Select
SendKeys "^v"
Application.Wait Now + TimeValue("00:00:2")
Next fname
Jeanno's right, if you have Acrobat then using its API library to work with the file directly is much better than the workarounds. I use this every day to convert pdf files into database entries.
Your code has a few problems, but I suspect the biggest issue is the use of SendKeys "^v" to paste into Excel. You're better off selecting the cell you want then using Selection.Paste. Or even better, transfer the contents of the clipboard to a variable, then parse it out as needed on the backend before writing to your spreadsheet--but that adds a bunch of complexity and doesn't help you a lot in this case.
To use the code below, be sure to select your 'Acrobat x.x Type Library' under Tools>References.
Sub StartAdobe1()
Dim fName As Variant
Dim wbTransfer As Excel.Workbook
Dim wsNew As Excel.Worksheet
Dim dOpenCol As Double
Dim oPDFApp As AcroApp
Dim oAVDoc As AcroAVDoc
Dim oPDDoc As AcroPDDoc
'Define your spreadsheet
Set wbTransfer = Workbooks("transfer (Autosaved).xlsm")
Set wsNew = wbTransfer.Sheets("new")
'Find first open column
dOpenCol = ws.Cells(1, columns.count).End(xlToleft).Column + 1
'Instantiate Acrobat Objects
Set oPDFApp = CreateObject("AcroExch.App")
Set oAVDoc = CreateObject("AcroExch.AVDoc")
Set oPDDoc = CreateObject("AcroExch.PDDoc")
For Each fName In Range("path")
'Open the PDF file. The AcroAVDoc.Open function returns a true/false
'to tell you if it worked
If oAVDoc.Open(fName.Text, "") = True Then
Set oPDDoc = oAVDoc.GetPDDoc
Else
Debug.Assert False
End If
'Copy all using Acrobat menu
oPDFApp.MenuItemExecute ("SelectAll")
oPDFApp.MenuItemExecute ("Copy")
'Paste into open column
wbTransfer.Activate
wsNew.Cells(1, dOpenCol).Select
ActiveSheet.Paste
'Select next open column
dOpenCol = dOpenCol + 1
oAVDoc.Close (1) '(1)=Do not save changes
oPDDoc.Close
Next
'Clean up
Set wbTransfer = Nothing
Set wsNew = Nothing
Set oPDFApp = Nothing
Set oAVDoc = Nothing
Set oPDDoc = Nothing
End Sub
Note:
1-There is also a menu item oPDFApp.MenuItemExecute ("CopyFileToClipboard") that should do the select all and copy in one step, but I have had problems with it so I stick to the two-step method above.
2-A pdf file consists of two objects, the oAVDoc and the oPDDoc. Different aspects of the file are controlled by each. In this case you might only need the oAVDoc. Try commenting out the lines dealing with oPDDoc and see if it works without them.
I can't quite get your code to work, but my guess is that it's copying all of the data, but overwriting it each time through the loop. To fix this try:
ActiveSheet.Cells(1, ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1).Select
instead of the two lines that begin activesheet.range("A1").Select and Selection.End....
try this code this might work:
Sub Shell_Copy_Paste()
Dim o As Variant
Dim wkSheet As Worksheet
Set wkSheet = ActiveSheet
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\red.pdf", vbNormalFocus)
Application.Wait (Now + TimeSerial(0, 0, 2)) 'Wait for Acrobat to load
SendKeys "^a" 'Select All
SendKeys "^c" 'Copy
SendKeys "%{F4}" 'Close shell application
wkSheet.Range("B5").Select
SendKeys "^v" 'Paste
End Sub
BELOW CODE WILL COPY DATA FROM PDF & will PASTE IT IN WORD THEN COPY DATA FROM WORD AND THEN PASTE IT TO THE EXCEL .
NOW Why I am copying data from pdf to word & then copying from word and pasting it to the excel because i want the data from the pdf in exact format to my excel sheet if i copy directly from pdf to excel it will paste the whole data from pdf into a single cell means even if i am having two columns or multiple rows it will paste all of my data into one column and that too in single cell but if i copy from word to excel it will retain its original format and two columns will get pasted as two columns only in excel.
Private Sub CommandButton3_Click() '(load pdf)
Dim o As Variant
Set appWord = CreateObject("Word.Application")
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\Book1.pdf", vbNormalFocus) 'loading adobe reader & pdf file from their location
Application.Wait (Now + TimeSerial(0, 0, 2))
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Application.Wait Now + TimeValue("00:00:01")
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
appWord.Documents.Add.Content.Paste
With appWord
.ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "\pdf" & ".docx", FileFormat:=wdocument 'saving word file in docx format
.ActiveWindow.Close
.Quit
End With
MsgBox " pdf is loaded "
MsgBox " Paste to EXCEL "
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
appWord.Documents.Open "C:\Users\saurabh.ad.sharma\Desktop\pdf.docx" 'opening word document
appWord.Selection.WholeStory
appWord.Selection.Copy
Set wkSheet = ActiveSheet
wkSheet.Range("A1").Select
wkSheet.Paste 'pasting to the excel file
End Sub
This is the more modified version of my above code it will not save any document it will save data in clipboard and will do the execution fast..
Private Sub CommandButton3_Click() '(load pdf)
Dim o As Variant
Set appWord = CreateObject("Word.Application")
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\Book1.pdf2", vbNormalFocus)
Application.Wait (Now + TimeSerial(0, 0, 2))
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Application.Wait Now + TimeValue("00:00:01")
Set appWord = CreateObject("Word.Application")
appWord.Visible = False
appWord.Documents.Add.Content.Paste
With appWord
.Selection.WholeStory
.Selection.Copy
.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
.Quit
End With
MsgBox " pdf is loaded "
MsgBox " Paste to EXCEL "
Set wkSheet = ActiveSheet
wkSheet.Range("A1").Select
wkSheet.Paste
End Sub
I had similar problem. The best solution is, as it was mentioned before, to use Adobe API. In my case it was impossible because macro was intended for 100+ users without Adobe Pro on their PC.
Ultimate solution that I have developed recently was to build converted in C# (for free using Visual Studio and iText library), install it on end users computers and run whenever I need via VBA. Here are some links for more guidance:
How to develop pdf converter in C#: link
How to create Excel Addin in C#: link
How to run C# addin from VBA: link
Overall it's fairly complicated but once done works like a dream.
Another solution as mentioned before is to use sendkeys in VBA. My experience is that it requires some optimization to handle various opening and copying times (depending on file size). Below is code that worked for me, however it's not even near that fast and stable as C# converter.
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'Initialize sleep function via Windows API
Public Sub CopyToSheet(destinationSheet As Worksheet, pathToPdf as String)
'Copy data from PDF to worksheet
'Initialize timer
Dim StartTime As Double
StartTime = Timer
'Clear clipboard
Dim myData As DataObject
Set myData = New DataObject
myData.SetText text:=Empty
myData.PutInClipboard
Set myData = Nothing
'Build file paths
Dim pathToAdobe As String
pathToAdobe = """C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"""
pathToPdf = """" & pathToPdf & """"
'Open PDF and wait untill it is open. If file is already opened it will be just activated
Dim pdfId As Long
pdfId = Shell(pathToAdobe & " " & pathToPdf, vbMaximizedFocus)
Do
Sleep (500)
If Round(Timer - StartTime, 2) > 9 Then MsgBox "Failed to open PDF": Exit Sub 'Safety check
Loop Until Me.IsPdfOpen(pathToPdf)
'Copy and wait until copying is completed
SendKeys "^a"
SendKeys "^c"
Do
Sleep (500)
If Round(Timer - StartTime, 2) > 18 Then MsgBox "Failed to copy data to clipboard": Exit Sub 'Safety check
Loop Until Me.GetClipboardStatus = "ClipboardHasData"
'Paste data into worksheet
destinationSheet.Activate
destinationSheet.Range("A1").Select
destinationSheet.Paste
'Close pdf
Call Shell("TaskKill /F /PID " & CStr(pdfId), vbHide)
'Clear clipboard
Set myData = New DataObject
myData.SetText text:=Empty
myData.PutInClipboard
Set myData = Nothing
End Sub
Function IsPdfOpen(pathToPdf) As Boolean
'Check if PDF is already opened
'Build window name (window name is name of the application on Windows task bar)
Dim windowName As String
windowName = pathToPdf
windowName = Mid(windowName, InStrRev(windowName, "\") + 1, Len(windowName) - InStrRev(windowName, "\") + 1)
windowName = windowName + " - Adobe Acrobat Reader DC"
'Try to activate application to check if is opened
On Error Resume Next
AppActivate windowName, True
Select Case Err.Number
Case 5: IsPdfOpen = False
Case 0: IsPdfOpen = True
Case Else: Debug.Assert False
End Select
On Error GoTo 0
End Function
Function GetClipboardStatus() As String
'Check if copying data to clipboard is completed
Dim tempString As String
Dim myData As DataObject
'Try to put data from clipboard to string to check if operations on clipboard are completed
On Error Resume Next
Set myData = New DataObject
myData.GetFromClipboard
tempString = myData.GetText(1)
If Err.Number = 0 Then
If tempString = "" Then
GetClipboardStatus = "ClipboardEmpty"
Else
GetClipboardStatus = "ClipboardHasData"
End If
Else
GetClipboardStatus = "ClipboardBusy"
End If
On Error GoTo 0
Set myData = Nothing
End Function

How to automate converting Excel xls files to Excel xml format?

I have about 200 Excel files that are in standard Excel 2003 format.
I need them all to be saved as Excel xml - basically the same as opening each file and choosing Save As... and then choosing Save as type: XML Spreadsheet
Would you know any simple way of automating that task?
Here is a routine that will convert all files in a single directory that have a .xls extension.
It takes a straight forward approach. Any VBA code in a workbook is stripped out, the workbook is not saved with a .xlsm extension. Any incompatability warning are not dislayed, instead the changes are automatically accepted.
Sub Convert_xls_Files()
Dim strFile As String
Dim strPath As String
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
'Turn off events, alerts & screen updating
strPath = "C:\temp\excel\"
strFile = Dir(strPath & "*.xls")
'Change the path as required
Do While strFile <> ""
Workbooks.Open (strPath & strFile)
strFile = Mid(strFile, 1, Len(strFile) - 4) & ".xlsx"
ActiveWorkbook.SaveAs Filename:=strPath & strFile, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close True
strFile = Dir
Loop
'Opens the Workbook, set the file name, save in new format and close workbook
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
'Turn on events, alerts & screen updating
End Sub
You could adapt the code I posted here:
http://www.atalasoft.com/cs/blogs/loufranco/archive/2008/04/01/loading-office-documents-in-net.aspx
It shows how to save as PDF (Word is shown in the blog, but if you download the solution, it has code for Excel and PPT).
You need to find the function for saving as the new format instead of exporting (probably the easiest way is to record a macro of yourself doing it in Excel and then looking at the code).
Open them all up, and then press ALT+F11 to get to macro editor and enter something like:
Sub SaveAllAsXml()
Dim wbk As Workbook
For Each wbk In Application.Workbooks
wbk.SaveAs FileFormat:=XlFileFormat.xlXMLSpreadsheet
Next
End Sub
And then press F5 to run it. May need some tweaking as I haven't tested it.
Sounds like a job for my favorite-most-underrated language of all time: VBScript!!Put this in a text file, and make the extension ".vbs":
set xlapp = CreateObject("Excel.Application")
set fso = CreateObject("scripting.filesystemobject")
set myfolder = fso.GetFolder("YOURFOLDERPATHHERE")
set myfiles = myfolder.Files
for each f in myfiles
set mybook = xlapp.Workbooks.Open(f.Path)
mybook.SaveAs f.Name & ".xml", 47
mybook.Close
next
I haven't tested this, but it should work
The simplest way is to record macro for one file and then manually edit macros to do such actions for files in folder using loop. In macro you can use standart VB functions to get all files in directory and to filter them. You can look http://www.xtremevbtalk.com/archive/index.php/t-247211.html for additional information.
Const xlXLSX = 51
REM 51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
REM 52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
REM 50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
REM 56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)
dim args
dim file
dim sFile
set args=wscript.arguments
dim wshell
Set wshell = CreateObject("WScript.Shell")
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open( wshell.CurrentDirectory&"\"&args(0))
objExcel.DisplayAlerts = FALSE
objExcel.Visible = FALSE
objWorkbook.SaveAs wshell.CurrentDirectory&"\"&args(1), xlXLSX
objExcel.Quit
Wscript.Quit

Resources