How To Open Non-Excel File with Excel Mac VBA - excel

There are numerous Q&A's for Excel WINDOWS, but none for Excel MAC that specifically answer this question.
Using Excel Mac 2011 VBA, how do I open a non-Excel file using the file's default app?
After much research and testing, I figured out the answer. See below.

This works running Microsoft Excel 14.7.2 (14.7.2) on macOS 10.12.6.
```vb
Sub open_file()
Dim scriptStr As String
Dim hfsPath As String
hfsPath = "~:Documents:Test File To Open From Excel.txt"
'--- Create AppleScript to Open Non-Excel File ---
' (Note: You cannot use POSIX path or POSIX commands)
' So, I have allowed for the tilde in a HFS path
' to mean the same as in a POSIX path: Users Home Folder
scriptStr = "set hfsPath to """ & hfsPath & """" & vbNewLine & _
"if (hfsPath starts with ""~"") then" & vbNewLine & _
" set homePath to (path to home folder) as text" & vbNewLine & _
" set hfsPath to homePath & (text 3 thru -1 of hfsPath)" & vbNewLine & _
"end if" & vbNewLine & _
"tell application ""Finder"" to open file hfsPath" & vbNewLine & _
"return hfsPath"
Debug.Print scriptStr
'--- Execute AppleScript to Open Non-Excel File ---
hfsPath = MacScript(scriptStr)
Debug.Print hfsPath
End Sub
```
For Excel Windows, see
How can Excel Windows VBA open file using default application

Related

Is there any way to export a custom Ribbon stored inside an .xlsm file?

I have this .xlsm file with a custom Ribbon. It has 8 buttons assigned to custom macros. Is there a way to extract the custom Ribbon into an .xlam?
If not, is there any way to open that custom Ribbon from another .xlsm?
I am using this code to extract the CustomUI file from the Excel-File. It creates a copy of the file from which then the customUI14.xml file gets extracted.
Assumption: C:\Program Files\7-Zip\7z.exe is available
I added this piece of code to sourcetools.xla to not only extract the modules but also the customUI for versioning.
Public Sub extractCustomUIToFolder(wb As Workbook, pathTarget As String)
Dim tmp As String
tmp = wb.Path & "~temp.xlsm"
wb.SaveCopyAs tmp
Dim strShellString As String
strShellString = "e " & Chr$(34) & tmp & Chr$(34) & _
" -o" & Chr$(34) & pathTarget & "\" & Chr$(34) & _
" customUI14.xml -r -aoa"
Dim exePath As String
exePath = Chr$(34) & "C:\Program Files\7-Zip\7z.exe" & Chr$(34) & " "
Call Shell(exePath & strShellString)
Kill tmp
End Sub
Using the according commands it is also possible to "re-import" the customUI14.xml file into the xlam
The only documentation I can find about importing and exporting custom ribbons is here
and here
Click File
Select Options.
Select Customize Ribbon.
Select Import/Export.
Select Export all Customizations.
Choose a destination and file name in the File Save window.
Click Save to finish.

Detect if Excel file has IRM (Information Rights Management) Restrictions using VBA without opening the file

I have an application written in Microsoft Access using VBA which opens Excel files, processes the contents in various ways and then closes them. If the a file cannot be opened, then I need to detect this and skip the file otherwise the application effectively freezes.
The Excel files come from numerous sources and if they are restricted I don't have the account credentials to open them.
With a password protected file I can supply an incorrect password, detect the error and then skip the file.
Application.Workbooks.Open(FileName, False, , , "xxxx", , True)
If the Excel file has had IRM (Information Rights Management) Restrictions applied to it, then when you open the file in the Excel application you are prompted to sign into Excel with an account that has permission to open the file.
If you try to open the file using the VBA code above with the Excel application not visible, then the process just halts and no error is generated.
What I need to do is either detect that the file has IRM applied to it before trying to open it or try to open it and generate an error that I can detect.
Thanks in advance for any help in solving this.
After trying a number of approaches to this I found that restricted files contain a string that indicates that they are secured with rights management.
So if you open the file and examine the contents you can detect if it's restricted without trying to load it into Excel.
This function works with all the files that I have tried it with.
Function IsFileRestriced(FileName As String) As Boolean
Dim lngFile As Long, lngPos As Long
Dim strContent As String
'Open the file in binary mode
lngFile = FreeFile
Open FileName For Binary As lngFile
'Read the whole file into a string
strContent = Space$(LOF(lngFile))
Get #lngFile, , strContent
'Check if the file has the rights management string
lngPos = InStr(1, strContent, "Microsoft Rights Label")
'Close the file
Close #lngFile
'Return the result
If lngPos > 0 Then IsFileRestriced = True
End Function
There is a clear example in the documentation:
Sub ShowPermissions()
Dim irmPermission As Office.Permission
Dim strIRMInfo As String
Set irmPermission = ActiveWorkbook.Permission
If irmPermission.Enabled Then
strIRMInfo = "Permissions are restricted on this document." & vbCrLf
strIRMInfo = strIRMInfo & " View in trusted browser: " & _
irmPermission.EnableTrustedBrowser & vbCrLf & _
" Document author: " & irmPermission.DocumentAuthor & vbCrLf & _
" Users with permissions: " & irmPermission.Count & vbCrLf & _
" Cache licenses: " & irmPermission.StoreLicenses & vbCrLf & _
" Request permission URL: " & irmPermission.RequestPermissionURL & vbCrLf
If irmPermission.PermissionFromPolicy Then
strIRMInfo = strIRMInfo & " Permissions applied from policy:" & vbCrLf & _
" Policy name: " & irmPermission.PolicyName & vbCrLf & _
" Policy description: " & irmPermission.PolicyDescription
Else
strIRMInfo = strIRMInfo & " Default permissions applied." & vbCrLf & _
" Default policy name: " & irmPermission.PolicyName & vbCrLf & _
" Default policy description: " & irmPermission.PolicyDescription
End If
Else
strIRMInfo = "Permissions are NOT restricted on this document."
End If
MsgBox strIRMInfo, vbInformation + vbOKOnly, "IRM Information"
Set irmPermission = Nothing
End Sub
SOURCE: https://learn.microsoft.com/en-us/office/vba/api/office.permission

Runtime Error 1004 for Excel 2016 for Mac Macro (used to work on Excel 2011 for Mac)

So I've tried looking around the net and forums for solving this but since I can't seem to understand this at all, I need a bit of advice.
I have a Macro that I used to run on Excel 2011 on Mac that I do not have anymore. When I try to run this on Excel 2016 on Mac, I am getting a Run-time Error '1004', Sorry we couldn't find (file location). Is it possible that it was moved, renamed etc error.
The Code is per below
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
MyScript = _
"set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & _
" {""com.microsoft.Excel.xls""} " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles <> "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MySplit = Split(MyFiles, ",")
For N = LBound(MySplit) To UBound(MySplit)
X = ActiveWorkbook.Name
Workbooks.Open (MySplit(N))
When I see the debug, it stops at the code Workbooks.Open (MySplit(N))
The file that its looking for exists in the location because I have to choose the file when it prompts me
Wondering if theres anyone that can help me out on what code to replace
Thank you
Following Mac Excel 2016 VBA - Workbook.open gives 1004 error, just modify output of applescript for file selection (which is something like Macintosh HD:Users:xxxx:Documents:yyyy.xlsx) by replacing : with / and Macintosh HD with "" enables Workbooks.Open() to work.

Is there any reason a VBA sub would stop working only on my PC?

I have a function (bastardised from Ron DeBruin's Website) that saves the active or selected sheet as a pdf and sends it as an attachment in outlook. It still works for everyone I've given it to but lately, it is not working on my PC. I keep getting the error message as if VBA cannot save the file (due to the path being invalid or the name being used already and not wanting to overwrite)
Running on various PCs that are either running on Windows 10 or 7 (I'm on Win10) I've tried changing the save file path & the filename in the code to something more simple and I still have the same issues. I tried the file on another machine running windows 10 and had no issues. I've also tried checking Microsoft Add-Ins and everything is fine.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RDB_Worksheet_Or_Worksheets_To_PDF_And_Create_Mail()
Dim FileName As String
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more than one sheet selected," & vbNewLine & _
"be aware that every selected sheet will be published"
End If
'Call the function with the correct arguments
'Tip: You can also use Sheets("YourSheetName") instead of ActiveSheet in the code(sheet does not have to be active then)
FileName = RDB_Create_PDF(Source:=ActiveSheet, _
FixedFilePathName:="C:\Users\" & Environ("Username") & "\Documents\Container Shipment Reports\" & (Range("G4").Value) & ".pdf", _
OverwriteIfFileExist:=True, _
OpenPDFAfterPublish:=False)
'For a fixed file name use this in the FixedFilePathName argument
'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
StrTo:="XXXXXX.XXXXXXX#XXXXX.com.au", _
StrCC:="XXXXXX.XXXXXXX#XXXXX.com.au; XXXXXX.XXXXXXX#XXXXX.com.au", _
StrBCC:="", _
StrSubject:="Container Shipment Report " & (Range("G4").Value) & ".", _
Signature:=True, _
Send:=False, _
StrBody:="<body>Hello,</body><br>" & _
"<body>Please see the attached Container Shipment Report# " & (Range("G4").Value) & " from " & (Range("E4").Value) & "." & _
"<br><br>" & "Thank you.</body>"
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exists"
End If
Application.Quit
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
This should convert to PDF, attach to an email, send the email and then close Excel. At the moment I am just getting the MsgBox response from the code, "Not possible to create PDF, possible reasons: etc".
(there is also a function to stop the excel file saving as it is meant to be a blank template.) As I said this seems to be an issue only on my machine but as it works on other computers I'm thinking there's no issue with the code.

Writing text from Excel 2007 to a .txt file on a Sharepoint Site causes Run-Time error'76' Path not found

I have this VBA sub in an Excel 2007 project. It records user name, report name, date, and version on a .txt file in a Sharepoint site. Some of my users are getting a Run-Time error'76' Path not found issue.
Here's my code:
Sub logReport(ReportName As String)
Call AppendTxt("//myaviall/teamsites/AviallReportingSolutions/Airplane_Usage_Log/Airplane_ACT.txt", UNameWindows & ";" & ReportName & ";" & Now & ";" & VersionNum)
Dim oFS, TS, FileObj
'Get text stream
'Set oFS = CreateObject("Scripting.FileSystemObject")
'Set FileObj = oFS.GetFile("//myaviall/teamsites/AviallReportingSolutions/Airplane_Usage_Log/Airplane_ACT.txt")
'Set TS = FileObj.OpenAsTextStream(8, -2) 'ForWriting, TristateUseDefault)
' Write to file
'TS.WriteLine UNameWindows & ";" & ReportName & ";" & Now & ";" & VersionNum
'TS.Close
'Set TS = Nothing
'Set FileObj = Nothing
'Set oFS = Nothing
End Sub
Function AppendTxt(sFile As String, sText As String)
On Error GoTo Err_Handler
Dim FileNumber As Integer
FileNumber = FreeFile ' Get unused file number
Open sFile For Append As #FileNumber ' Connect to the file
Print #FileNumber, sText ' Append our string
Close #FileNumber ' Close the file
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: AppendTxt" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
If there is only one user that is getting the issue the first thing that I would look at it access, as Scott points out.
I run a very similar procedure which writes a line to a csv file from outlook based on the code here
http://www.devhut.net/2011/06/06/vba-append-text-to-a-text-file/
This is probably not your answer but if the access is ok then it couldnt hurt to try another method.
Update
I also include this into my code to test if the file exists
exists = Dir$(sFile) <> fileName
Where fileName = "Airplane_ACT.txt" But I would maybe try this with a msgBox to see what it returns.
Also try try changing your string to Airplane_ACT_test.txt and run the code, this should create a new txt file, if this is the case then the issue may be related to your initial txt file.
Last thing: try with a different path eg: to the user's desktop.

Resources