Open PDF file in Excel with VBA - excel

I am having trouble opening my pdf file in excel. I wrote a macro to open a pdf document, copy everything and paste it into an excel workbook but I cant get the pdf file to open. I keep getting the 1004 runtime error. Any ideas of help would be appreciated. Here is what I have tried so far:
Public Sub PDFCopy()
Dim o As Variant
Dim App As AcroPDDoc
Worksheets("Sheet3").Range("A2").Activate
'App.Open ("C:\NetworkDiagrams\100-Viking.pdf")
o = Shell("calc.exe", vbNormalNoFocus)
' ActiveWorkbook.FollowHyperlink ("C:\NetworkDiagram\100-Viking.pdf")
Application.Wait Now + TimeValue("00:00:05")
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Worksheets("Sheet3").Range("A2").Activate
SendKeys ("^v")
End Sub
All three methods have given me the same runtime error. I am out of ideas.

There are two ways to do this.
First, you need to know what is installed in your system.
Acrobat is different from Acrobat or Adobe Reader.
Here's the code if you only have Acrobat Reader. You use the Shell function.
Then to copy the content of PDF, you use the SendKeys.
Kind of dirty code and not 100% reliable but I can say that it still works.
Sub Get_Pdf()
Dim XLName As String, PDFPath As String, READERPath As String
Dim OpenPDF, sh As Worksheet
XLName = ThisWorkbook.Name
Set sh = Thisworkbook.Sheets(1)
PDFPath = Application.GetOpenFilename(filefilter:="PDF file (*.pdf), *.pdf")
If UCase(PDFPath) = "FALSE" Then Exit Sub
'~~> Below path differs depending Adobe version and installation path
READERPath = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe "
Shell READERPath & PDFPath, vbNormalFocus: DoEvents
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a", True
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c"
Application.Wait Now + TimeValue("00:00:2")
Windows(XLName).Activate
sh.Paste sh.Range("A1")
SendKeys "%{F4}", True
End Sub
If however you have the Acrobat Installed, refer to this post and check the link posted on the correct answer.
An update was posted on the link and it covers opening PDF even if only ADOBE reader is installed.

Not sure if this will work for you, but it opens the PDF and copies it in A2; hopefully someone can chime in with something a little cleaner.
Public Sub PDFCopy()
'Filepath for your Adobe reader
MyPath = "C:\Program Files\Adobe\Reader 10.0\Reader\AcroRd32.exe"
'Filepath for your PDF to open
MyFile = "C:\Documents\test.pdf"
Shell MyPath & " " & MyFile, vbNormalFocus
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Windows("Test.xlsm").Activate
Worksheets("Sheet2").Activate
ActiveSheet.Range("A2").Select
SendKeys ("^v")
End Sub

Related

Open PDF and save specific pages as new PDF

I have a PDF that I need to mail out each day. I have a macro set up in my excel file that updates a table of data that goes in the body of the email and then it opens up this PDF file and saves 4 pages as a PDF and attaches it to the email that I send.
The problem is, sendkeys really isn't that reliable and I'd like to use something else or have it just silently open and save those specific pages as a new pdf in my temp folder. Any ideas would be appreciated!
Option Explicit
Public Sub Print_All_PDF_Files_in_Folder()
On Error Resume Next
Kill "C:\temp\S4 Region.pdf"
On Error GoTo 0
Dim folder As String
Dim PDFfilename As String
folder = "location of pdf" 'CHANGE AS REQUIRED
If Right(folder, 1) <> "\" Then folder = folder & "\"
PDFfilename = Dir(folder & "S4 Reg" & "*.pdf", vbNormal)
While Len(PDFfilename) <> 0
Print_PDF folder & PDFfilename
PDFfilename = Dir() ' Get next matching file
Wend
Call ClosePDF
End Sub
Private Sub Print_PDF(sPDFfile As String)
Shell "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe /p " & Chr(34) & sPDFfile & Chr(34)
SendKeys "p"
SendKeys "%g"
SendKeys "{tab}"
SendKeys "5,9,14,15"
SendKeys "%r"
SendKeys "{down 2}"
Application.Wait DateAdd("s", 10, Now)
SendKeys "{enter}"
Application.Wait DateAdd("s", 15, Now)
SendKeys "{tab 6}"
SendKeys "{enter}"
SendKeys "C:\temp"
SendKeys "%s"
Application.Wait DateAdd("s", 10, Now)
End Sub
Sub ClosePDF()
Dim Process As Object, intError As Integer
For Each Process In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("select * from win32_process where name='AcroRd32.exe'")
intError = Process.Terminate 'Terminates a process and all of its threads.
If intError <> 0 Then Exit For 'Return value is 0 for success. Any other number is an error.
Next
End Sub
silently open and save those specific pages as a new pdf in my temp folder.
You need to use the Workbook.ExportAsFixedFormat method which is used to publish a workbook to either the PDF or XPS format. Pay attention to the following parameters:
From - The number of the page at which to start publishing. If this argument is omitted, publishing starts at the beginning.
To - The number of the last page to publish. If this argument is omitted, publishing ends with the last page.
OpenAfterPublish - If set to True, displays the file in the viewer after it is published. If set to False, the file is published but not displayed.
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF FileName:="sales.pdf" Quality:=xlQualityStandard From:=2 To:=4 OpenAfterPublish:=True

Use VBA to Open A Folder And Sort By Date Modified?

I currently use:
Call Shell("explorer.exe " & str_folder, vbNormalFocus)
to open a folder but would like to add some extra code to make this open but already listed in date modified with most recent at top?
Actually this could work (tested in Windows 10). But as usual the SendKeys statement only simulates key strokes and therefore is not a very reliable method.
Option Explicit
Public Sub OpenExplorerSortByDate()
Const str_folder As String = "c:\"
Shell "explorer.exe " & str_folder, vbNormalFocus
Application.Wait (Now + TimeValue("00:00:03"))
SendKeys "%"
SendKeys "A"
SendKeys "O"
SendKeys "{DOWN}"
SendKeys "{ENTER}"
End Sub

What is the Correct Shell Function Code to Open a File Type

Could someone please help with problem running code below. It works when I specify only 1 filename in the Shell function but when I try a loop, whereby I want Shell to simply be a file opener of file type specified (ie .sim), the system loops endlessly; opening the .exe and presenting a dialogue box from opened executable program "file doesn't exist".
Background: I've many .sim files in a folder that I want to perform an execution using code inside loop below. Once the task for first opened .sim file is complete I want to loop through all remaining .sim files.
Xidgel I try this and it works well only once and then trying again it fails;
Sub Test1()
Dim strProgramName As String
Dim Foldername As String
Dim Fname As String
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = False
Dim windowStyle As Integer: windowStyle = 1
strProgramName = "C:\userspath.exe"
Foldername = "C:\whatever\"
Fname = Dir(Foldername & "*.sim")
Do While Len(Fname)
wsh.Run strProgramName & " " & Foldername & Fname, windowStyle, waitOnReturn
Application.Wait Now + TimeValue("0:00:02")
SendKeys "(%)m"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{DOWN 13}"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{ENTER}"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{ENTER}"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "(^S)"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "%{F4}"
Fname = Dir()
Loop
MsgBox "Task Complete!"
End Sub
The following code works for me (sending text and commands to a series of files edited using Notepad):
Public Sub test()
Dim strProgramName As String
Dim Foldername As String
Dim Fname As String
Dim TaskID As Variant
strProgramName = "C:\Windows\system32\notepad.exe"
Foldername = "C:\temp\"
Fname = Dir(Foldername & "*.dat")
Do While Len(Fname)
' Call Shell("""" & strProgramName & """ """ & Fname & """")
TaskID = Shell(strProgramName & " " & Foldername & Fname, vbNormalFocus)
AppActivate TaskID
Application.SendKeys "ABC" & vbCr, True ' Add some text
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys "^s", True ' CTRL-s = save
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys "%{F4}", True ' Alt-F4 = Quit
Application.Wait Now + TimeValue("0:00:02")
' Get next file
Fname = Dir()
Loop
MsgBox "Task Complete!"
End Sub
For me use of SendKeys was a little fragile. I needed the call to AppActivate to make sure the keystrokes were directed to Notepad. I first tried the Shell command without using vbNormalFocus and only some of my keystrokes made it through to Notepad. Also, when I tried to run the code from the VBA environment the keystrokes got sent to Excel, so I had to test by running from Excel.
Hope this get you started.
OK Here's a new version that opens the .exe once, opens/edits/saves/closes a series of files, then closes the .exe. I hope is closer to a solution.
Public Sub send_keys_test_2()
Dim strProgramName As String
Dim Foldername As String
Dim Fname As String
Dim TaskID As Variant
' In version 1 I tested with Notepad
' This version won't work with Notepad because it assumes
' a multiple document interface (MDI). Specifically, we want
' an .exe that can be open without having documents open. Notepad
' fails this requirement --- if you close a document in Notepad
' then the Notepad application closes too. So in this version
' I will test with MS Word.
' Modify to suit your purposes.
strProgramName = "C:\Program Files (x86)\Microsoft Office\Office14\WINWORD.exe"
' My test files are in C:\temp
' Modify to suit your purposes
Foldername = "C:\temp\"
' My test files are a series of Word Docs
' Modify to suit your purposes
Fname = Dir(Foldername & "File*.doc")
' If there are no matching files, then exit
If Len(Fname) = 0 Then Exit Sub
' Otherwise, start the .exe WITHOUT opening any files
TaskID = Shell(strProgramName, vbNormalFocus)
' Allow plenty of time for the .exe to open
Application.Wait Now + TimeValue("0:00:10")
' Make sure the keystrokes get sent to the .exe
AppActivate TaskID
Do While Len(Fname)
' Call Shell to open the first file
' In Word, send CTRL-o to display the file open dialog box
' Then send the Foldername + FName
' Then send an ENTER key to complete the file open
' Modify this to suit your purposes
Application.SendKeys "^o", True ' CTRL-o = open
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys Foldername & Fname, True ' Send the file name
Application.SendKeys "~", True ' Send {Enter} to close dialog, open file
' Now edit the file
' For demo purposes, just send a few new chars
Application.SendKeys "ABC" & vbCr, True ' Add some text
' Save the file
' In Word, send CTRL-s
' Modify to suit your purposes
Application.SendKeys "^s", True ' save
' Close the file
' In Word, send CTRL-w
' Modify to suit your purposes
Application.SendKeys "^w", True ' save
' Get next file
Fname = Dir()
Application.Wait Now + TimeValue("0:00:02")
Loop
' Send the quit command
' In Word, send Alt-F4
' Modify to suit your purposes
AppActivate TaskID
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys "%{F4}", True ' Alt-F4 = Quit
MsgBox "Task Complete!"
End Sub
Hope this helps.

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

Is there an alternative to Scripting.FileSystemObject in Excel 2011 VBA for the mac?

The answers to How can I install/use “Scripting.FileSystemObject” in Excel 2011 for MAC? seem to indicate that using Scripting.FileSystemObject in Excel 2010 for the mac is not possible.
What other alternative is available so I can:
get a collection of all Excel files in a specific directory
iterate through each worksheet within each file and export it to a .csv file
Currently this is a six-step process for each file:
--how to create CSV files for all worksheets in a file:
1. open file
2. click "Developer"
3. click editor
4. click ThisWorkbook
5. copy in:
Sub save_all_csv()
On Error Resume Next
Dim ExcelFileName As String
ExcelFileName = ThisWorkbook.Name
For Each objWorksheet In ThisWorkbook.Worksheets
Filename = "FILE-" & ExcelFileName & "-WORKSHEET-" & objWorksheet.Name & ".csv"
objWorksheet.SaveAs Filename:="Macintosh HD:Users:edward:Documents:temporaryNoBackup:" & Filename, FileFormat:=xlCSV, CreateBackup:=False
Next
Application.DisplayAlerts = False
Application.Quit
End Sub
6. click run (it closes by itself)
I'm looking for a way to automate this on the Mac, ideally, a (cron job?, service?) would open the excel file every 10 minutes, which would in turn look in a directory, convert all the other Excel files to .csv files, and then close by itself.
Without Scripting.FileSystemObject, how can I make this Excel-to-CSV conversion fully automatic on the Mac?
The only way I can think of is using the "Dir" function. Since mac supports extra characters in their filenames, wildcards do not work with the "Dir" function. Here is a sample.
Function GetFileList(folderPath As String) As Collection
'mac vba does not support wildcards in DIR function
Dim file As String
Dim returnCollection As New Collection
If Right$(folderPath, 1) <> "/" Then
folderPath = folderPath & "/"
End If
file = Dir$(folderPath) 'setup initial file
Do While Len(file)
returnCollection.Add folderPath & file
file = Dir$
Loop
Set GetFileList = returnCollection
End Function
You can put the VBA in an add-in (.xlam file) that is attached to Excel itself, rather than the workbook. For your example code, the only modification would be to write against ActiveWorkbook instead of ThisWorkbook.
Sub save_all_csv()
On Error Resume Next
Dim ExcelFileName As String
ExcelFileName = ActiveWorkbook.Name
For Each objWorksheet In ActiveWorkbook.Worksheets
Filename = "FILE-" & ExcelFileName & "-WORKSHEET-" & objWorksheet.Name & ".csv"
objWorksheet.SaveAs Filename:="Macintosh HD:Users:edward:Documents:temporaryNoBackup:" & Filename, FileFormat:=xlCSV, CreateBackup:=False
Next
Application.DisplayAlerts = False
Application.Quit
End Sub
You can also leverage auto_open() to automate binding a hotkey. Once that's done, you can just open a workbook, press a hotkey, and get your CSV files.
Public Sub auto_open()
' Register hotkeys
' See key codes here
' https://msdn.microsoft.com/en-us/vba/excel-vba/articles/application-onkey-method-excel
' ^ = CTRL
' % = ALT
' + = SHIFT
Application.OnKey "^+e", "save_all_csv" ' Ctrl+Shift+E will call save_all_csv()
End Sub

Resources