Open other application from vba - vba

I am working on a macro to open a file(might already be open) and save with new name and then open the new file from vba in excel.
This file can Powerpoint,mathcad,visio, word etc..(can also be template files such as dotx etc..)
So my idea is that:
I first need to figure out if the application is open or not,
then I somehow need to figure if the file is open or not,
then save it with the new filename.
Open the new document
Go through the document and dumps custom variables into the database, populate custom variables from database(Not shown in code below, seperate module)
Activate the new document so that the user can edit it.
Public Sub saveAsVBADocument(filenameNew As String, fileNameOld As String, applicationType As String)
Dim objectApplication As Object
Dim documentApplication As Object
On Error Resume Next
Set objectApplication = GetObject(, applicationType)
On Error GoTo 0
If objectApplication Is Nothing Then
Set objectApplication = CreateObject(applicationType)
End If
objectApplication.Visible = True
On Error Resume Next
Set documentApplication = objectApplication.Workbooks(FileHandling.GetFilenameFromPath(fileNameOld)) 'Excel
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'Word
Set documentApplication = objectApplication.WorkSheets(FileHandling.GetFilenameFromPath(fileNameOld)) 'Mathcad
Set documentApplication = objectApplication.Presentations(FileHandling.GetFilenameFromPath(fileNameOld)) 'PowerPoint
Set documentApplication = objectApplication.Projects(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Project "Msproject.Application"
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Visio "Visio.Application"
If documentApplication Is Nothing Then
Set documentApplication = objectApplication.FileOpen(fileNameOld) ' add read only
End If
documentApplication.SaveAs filename:=filenameNew
Set objectApplication = Nothing
Set documentApplication = Nothing
End Sub
What is a possible solution to handle all vba acceptable document types?

You can use GetObject("Filename") to open a file directly in its application. So something like this can open any file that has its extension in the Windows Registry. That will be most file types; certainly the Office applications. Whether you'll be able to use SaveAs will depend on whether those applications support OLE Server (meaning they have a coding interface exposed). Again, all the Office applications do support this.
You'll probably want to put in some error-handling for the case the application for the file extension can't be found in the Registry. And of course in case the file name doesn't exist.
My example is for Excel and Word, only - you should be able to fill in others. My code makes sure the file is visible and available to the user as that makes it easier to trouble-shoot. You can, of course, change that once you have everything working satisfactorily.
Sub OpenFileInUnknownApp()
Dim objFile As Object
Dim objApp As Object
Dim sPath As String, sExt As String
Dim sFileName As String
Dim sAppName As String
Dim snewfilename As String
sPath = "C:\Test\"
sFileName = sPath & "Quote.docx" 'RngNames.xlsx"
snewfilename = sPath & "NewName"
'''Open the file in its application
Set objFile = GetObject(sFileName)
Set objApp = objFile.Application
sAppName = objApp.Name
Select Case sAppName
Case Is = "Microsoft Excel"
Dim wb As Excel.Workbook
sExt = "xlsx"
objApp.Visible = True
Set wb = objFile
wb.Activate
wb.Windows(1).Visible = True
objApp.UserControl = True 'so that it "lives" after the code ends
objApp.Activate
wb.SaveAs "sNewFileName" & sExt
Case Is = "Microsoft Word"
Dim doc As word.Document
sExt = "docx"
objApp.Visible = True
Set doc = objFile
objApp.Activate
doc.SaveAs2 "sNewFileName" & sExt
Case Else
End Select
Set objFile = Nothing
Set objApp = Nothing
End Sub

Related

Saving a Word document and setting DisplayAlerts to disable prompt to save

I'm trying to use Application.DisplayAlerts = wdAlertsNone or Application.DisplayAlerts = False to avoid a Word popup message just before saving a Word document.
The document being saved contains track changes Continue with save?
Private Sub CreateReportButton_Click()
Dim objDocA As Word.Document
Dim objDocB As Word.Document
Dim objDocC As Word.Document
Dim objFSO As Scripting.FileSystemObject
Dim objFolderA As Scripting.Folder
Dim objFolderB As Scripting.Folder
Dim objFolderC As Scripting.Folder
Dim colFilesA As Scripting.Files
Dim objFileA As Scripting.File
Dim i As Integer
Dim j As Integer
Set objFSO = New FileSystemObject
Set objFolderA = objFSO.GetFolder(ChooseFolder("Choose the folder with the original documents", ThisDocument.Path))
Set objFolderB = objFSO.GetFolder(ChooseFolder("Choose the folder with revised documents", ThisDocument.Path))
Set objFolderC = objFSO.GetFolder(ChooseFolder("Choose the folder for the comparisons documents", ThisDocument.Path))
Set colFilesA = objFolderA.Files
For Each objFileA In colFilesA
If objFileA.Name Like "*.docx" Then
Set objDocA = Documents.Open(objFolderA.Path & "\" & objFileA.Name)
Set objDocB = Documents.Open(objFolderB.Path & "\" & objFileA.Name)
Set objDocC = Application.CompareDocuments( _
OriginalDocument:=objDocA, _
RevisedDocument:=objDocB, _
Destination:=wdCompareDestinationNew)
objDocA.Close
objDocB.Close
On Error Resume Next
Kill objFolderC.Path & "\" & objFileA.Name
On Error GoTo 0
'Turn off DisplayAlerts
Application.DisplayAlerts = wdAlertsNone
objDocC.SaveAs FileName:=objFolderC.Path & "\" & objFileA.Name
objDocC.Close SaveChanges:=False
End If
Next objFileA
End Sub
Apparently it depends on the version of office, In 2013 it's necessary to go to the Trust Center area of the application (File > Options > Trust Center > Trust Center Settings > Privacy Options) and uncheck the option "Warm before printing, saving or sending a file that contains tracked changes or comments". After doing that files are saved with any message of Word
If you need to retain those settings, then for the purposes of your code you could use something along the lines of:
Options.WarnBeforeSavingPrintingSendingMarkup = False
ActiveDocument.Save
Options.WarnBeforeSavingPrintingSendingMarkup = True
or, for more flexibility with systems that may not be using that setting:
Dim bWarn as Boolean
bWarn = Options.WarnBeforeSavingPrintingSendingMarkup
Options.WarnBeforeSavingPrintingSendingMarkup = False
ActiveDocument.Save
Options.WarnBeforeSavingPrintingSendingMarkup = bWarn

How do I obtain the path towards the macro using the macro (vba code) itself?

Note: I am not interested in finding the path towards the worksheet, I intend to write the path to the worksheet in a text file that is located in the same folder as the .OTM file.
I need to transform this code from hardcoded path to a path read from a text file located in the same folder as the macro.
How do I obtain the path towards the macro using the macro (vba code) itself?
Public xlApp As Object
Public xlWB As Object
Public xlSheet As Object
Sub OpenXl()
Dim enviro As String
Dim strPath As String
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
strPath = enviro & "\Documents\test2.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
' Process the message record
On Error Resume Next
End Sub
The OTM file is stored here on my PC (Windows 7/Outlook 2010):
strPath = Environ("userprofile") & "\AppData\Roaming\Microsoft\Outlook\"
Simply use:
ThisWorkbook.Path
This returns the path of the workbook containing the code.

How to save Word document in specified folder with filedialog.saveas?

I used the MO 14.0 Object library.
I want to open the filedialog.saveas where the user can choose the folder to save a Word document. Then open the document and write data from an Access database.
I found how to open, to fill in the data and how to open the filedialog.
The problem is that the chosen datafile is not saved at the location where it should be.
Private Sub Befehl44_Click()
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
With objWord
.Visible = True
.Documents.Open (CurrentProject.Path & "\template.docx") 'template for word document
.activedocument.Bookmarks("email").Select
.Selection.Text = Me!email
.activedocument.Bookmarks("name").Select
.Selection.Text = Me!name
.Application.FileDialog(msoFileDialogSaveAs).Show
strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
End With
Set objWord = Nothing
End Sub
Does strPath return the correct filepath the user selected for saving?
If it does, you just need to call the SaveAs method directly from Word
After
strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
Insert Lines
If strPath <> "" Then
.ActiveWorkbook.SaveAs strPath
End If
Or - just replace it with one line
ActiveWorkbook.SaveAs filename:=Application.GetSaveAsFilename

save pptx as pdf through excel

I am trying to convert all pptx files in a give path to pdf files.
my code:
Sub pptxtopdf()
Dim ppt As Object
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
On Error Resume Next
Set ppt = GetObject(, "PowerPoint.Application")
If ppt Is Nothing Then
Set ppt = CreateObject("PowerPoint.Application")
End If
On Error GoTo 0
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("P:\Operations\Data & Deliverables\Projects\Amica\presentation_workspace\1_ spring 2015\Presentations\Volvo")
i = 1
'loops through each file in the directory
For Each objFile In objFolder.Files
Set WDReport = ppt.Presentations.Open(objFile.Path)
Dim FileName2 As String
FileName2 = Replace(objFile.Path, "pptx", "pdf")
'WDReport.ExportAsFixedFormat FileName2, ppFixedFormatTypePDF
WDReport.SaveAs FileName2, ppSaveAsPDF
WDReport.Close
ppt.Quit
Set ppt = Nothing
Set WDReport = Nothing
i = i + 1
Next objFile
End Sub
error msg
Presentation.SaveAs : Invalid enumeration value.
Cannot see what I'm doing wrong?
same problem as here but the solution didnt work for me - Excel macro to save pptx as pdf; error with code
You are late binding PowerPoint.Application so its enumeration values are not exposed or available in the global VBA namespace.
As you have not added option explicit to warn you of undeclared variables your use of the undeclared ppSaveAsPDF causes no error but has no value.
Add:
const ppSaveAsPDF as long = 32
To the top of the module to provide the expected value to SaveAs.

Two clicks to generate word document from access form, with double rich text copied using vba

I've been working in exporting a rtf (rich text) form a memo field in access 2010 to a word file with a bookmark. The problem is that It is necessary two clicks to open the word document, and then, the text is inserted twice. I'm still not able to find the problem.
Here is the code:
Option Compare Database
Private Sub Comando72_Click()
'Saves the current record -->
Me.Dirty = False
Dim appWord As Word.Application
Dim doc As Word.Document
Dim objWord As Object '' Word.Application
Dim fso As Object '' FileSystemObject
Dim f As Object '' TextStream
Dim myHtml As String
Dim tempFileSpec As String
' grab some formatted text from a Memo field
myHtml = DLookup("DescripActivAEjecutarse", "PlanificacionServiciosInstitucionales", "IdPSI = Form!IdPSI")
Set fso = CreateObject("Scripting.FileSystemObject") '' New FileSystemObject
tempFileSpec = fso.GetSpecialFolder(2) & "\" & fso.GetTempName & ".htm"
'' write to temporary .htm file
Set f = fso.CreateTextFile(tempFileSpec, True)
f.Write "<html>" & myHtml & "</html>"
f.Close
Set f = Nothing
Set fso = Nothing
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
Set appWord = New Word.Application
End If
'set the doc for future use.
Set doc = appWord.Documents.Open("C:\Users\earias\Documents\SOLICITUD-Yachay-automatica2.docx", , True) 'True default (just reading).
'locates bookmark and inserts file
appWord.Selection.GoTo what:=wdGoToBookmark, Name:="bookmark_1"
appWord.Selection.InsertFile tempFileSpec
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
If you are pressing the button twice it will run the procedure twice?
In terms of your current code,
after this line Set doc = appWord.Documents.Open add the following;
doc.visible = true
This should enable you to view the document that's open when you press the button once. To prevent the window from popping up you could also instead of setting it to visible do;
doc.saveas "path here"
then set all to nothing and close off as you would and the file will be saved where you want it saved without needing to manually save as each time.
You could look at setting up a simple mail merge with a template and then saving-as the template to whichever format you choose and break the mailmerge link (my preferred method).
Let me know how you get on!