Open Excel from Word using FileDialog - vba

What I want to do is:
Press a button in my Microsoft Word doc it will prompt me to select a document in the file explorer.
Select my document the relevant fields in my word doc will be populated.
This will be populated based upon information in the document (the month) and using a Match function it will search for the correct row/column in the selected excel document and return the value.
I am stuck on the FileDialog(msoFileDialogFilePicker) section of my code below.
For the purpose of my document I can not enter the direct file path, the file path needs to be taken from the FileDialog function (or something similar).
I have also tried GetOpenFilename. I am unsure how to do this. My code currently opens FileDialog and lets me select a file, but I can not pass the file path onto my colNum1 line.
The error I get is Run-time error '91'. Object variable or With Block variable not set.
I am open to suggestions and any help is much appreciated.
Sub KPI_Button()
'
' KPI_Button Macro
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim strFile As String
Dim Doc As String
Dim Res As Integer
Dim dlgSaveAs As FileDialog
Doc = ThisDocument.Name
Set dlgSaveAs = Application.FileDialog(msoFileDialogFilePicker)
Res = dlgSaveAs.Show
colNum1 = WorksheetFunction.Match("(Month)", ActiveWorkbook.Sheets("Sheet1").Range("A2:I2"), 0)
ThisDocument.hoursworkedMonth.Caption = exWb.Sheets("Sheet1").Cells(3, colNum1)
exWb.Close
Set exWb = Nothing
End Sub

try a dialog that specifies an Excel extension as such:
Sub GetNames()
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel files", "*.xls*", 1
If .Show = True Then
If .SelectedItems.Count > 0 Then
'this is the path you need
MsgBox .SelectedItems(1)
Else
MsgBox "no valid selection"
End If
End If
End With
End Sub

Related

VBA FileDialog saves powerpoint as .ppt instead of .pptx

I have a PowerPoint with a couple macros: one that allows you to load some data from a Word, and another one that exports the PowerPoint to the same location where the Word was. This is the latter:
Sub export()
Dim dlgSaveAs As FileDialog
Dim strMyFile As String
Dim ppPres As Presentation
Set dlgSaveAs = Application.FileDialog(Type:=msoFileDialogSaveAs)
With dlgSaveAs
.InitialFileName = path & "Exported without macros - " & company & " (((insert date)))"
If .Show = -1 Then
strMyFile = .SelectedItems(1)
'MsgBox strMyFile
ActivePresentation.SaveAs strMyFile, 1
'-- save your file to strMyFile here
Else
'MsgBox "No file selected."
'-- The user pressed Cancel.
End If
End With
Set dlgSaveAs = Nothing
End Sub
To be honest, I didnĀ“t wrote this code. I found it months ago and adapted it and I dont know how it really works.
The issue is that when the 'Save As' FileDialog opens, the file extension seems to be ok:
But after pressing 'save' the file gets saved as a .ppt:
Any idea how to fix this?
Change this:
ActivePresentation.SaveAs strMyFile, 1
to this:
ActivePresentation.SaveAs strMyFile, 24
or to
ActivePresentation.SaveAs strMyFile, ppSaveAsOpenXMLPresentation

Copy the contents of a document(s) through FileDialogbox picker, to a new one

With MS_Word 2010 I have been trying to achieve the way to copy the contents(whole) of one file to a new one retrieving the file name of the original and adding it to the new one with the suffix "Copy".
All this process has a reason, since the Original document has only a few editable section and have protection enable (And I cant disable it) but I need to review it with other macro, so with a Copy of the contents in a new document I have been able to apply my whole macro. I also know of the method CopyFile but since this method copy also the characteristic of the original doc (the constrains in edit) I decide not to use it.
Searching around and using the recorder(for the copy actions) i have been able to come with this:
Sub Backup()
Dim DocName As String
Dim DocPath As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path of each selected item. Even though the path is aString, the variable must be a Variant because For Each...Next, routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
'Allow the user to select multiple files.
.AllowMultiSelect = True
'Use the Show method to display the File Picker dialog box and return the user's action.
'If the user presses the button...
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
On Error Resume Next
'vrtSelectedItem is aString that contains the path of each selected item. You can use any file I/O functions that you want to work with this path.
'MsgBox "Selected item's path: " & vrtSelectedItem
'Retrieve the name of the current doc (later I found out about .Name, .Path, .FullName ...)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
DocName = fso.GetBaseName(vrtSelectedItem)
'MsgBox "Selected item's : " & DocName
'Retrieve the path without the filename/extention
Documents.Open(vrtSelectedItem).Active
DocPath = ActiveDocument.Path
'MsgBox "Selected item's path: " & DocPath
'Copy the content of the current document
'With Documents(DocName)
With ActiveDocument
.WholeStory
.Copy
End With
'Create Backup File with ability to modify it, since the original is protected by password and only few segments are enable to edit
Documents.Add Template:=DocName & "Copy", NewTemplate:=False, DocumentType:=0
'Since Document.Add its suppose to promp as the Active document
'Paste the contents and save
'With Documents(DocName & "Copy")
With ActiveDocument
.PasteAndFormat (wdUseDestinationStylesRecovery)
.SaveAs DocPath
End With
'Documents(DocName & "Copy").Close SaveChanges:=True
Next
'If the user presses Cancel...
Else
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Sub
But as you guess, it doesn't work as desire and don't create the copy neither the new document with the name. So any scope in the right direction will be appreciate.
Thanks in advance for all the answers.
For future reference here is the code improved, based in the Response of #Charlie
Sub Backup()
Dim DocName As String
Dim NewDoc As Document
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path of each selected item. Even though the path is aString, the variable must be a Variant because For Each...Next, routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
'Allow the user to select multiple files.
.AllowMultiSelect = True
'Use the Show method to display the File Picker dialog box and return the user's action.
'If the user presses the button...
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
On Error Resume Next
'vrtSelectedItem is aString that contains the path of each selected item. You can use any file I/O functions that you want to work with this path.
'MsgBox "Selected item's path: " & vrtSelectedItem
'Retrieve the name of the current doc (later I found out about .Name, .Path, .FullName ...)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
DocName = fso.GetBaseName(vrtSelectedItem)
'MsgBox "Selected item's : " & DocName
'Create Backup File with ability to modify it, since the original is protected by password and only few segments are enable to edit
Set NewDoc = Documents.Add
'Since Document.Add its suppose to promp as the Active document
'Paste the contents and save
With NewDoc
Selection.InsertFile FileName:=vrtSelectedItem, Range:=vbNullString, _
ConfirmConversions:=False, Link:=False, Attachment:=False
.SaveAs FileName:=vrtSelectedItem & "_BACKUP.docx"
.Close
End With
Next
'If the user presses Cancel...
Else
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Sub
I would try creating a new Word doc then using this line to "insert the text from the protected Word doc." It's the same as going to the Insert Ribbon tab -> Object -> Text from File.
Selection.InsertFile FileName:="protected.docx", Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False

MS-ACCESS Copying file via vba with file dialog

I'm trying to create a button that opens up a file dialog, then lets you select a image to copy into a folder with the database. I've been working with this code but I'm stuck at the filecopy command, I can't seem to format it correctly. I use the pathway of the database plus a few folders then finally a combo box to select the specific folder to create the pathway (so that it doesn't break if the database is moved, and the combo box sorts the images based on category). Here's the code I've been using. Thanks guys.
Private Sub Command156_Click()
Dim fDialog As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim varFile As Variant
' Set up the File Dialog. '
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = [Application].[CurrentProject].[Path]
With fDialog
' Allow user to make multiple selections in dialog box '
.AllowMultiSelect = False
' Set the title of the dialog box. '
.Title = "Please select a Image"
' Clear out the current filters, and add our own.'
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the '
' user picked at least one file. If the .Show method returns '
' False, the user clicked Cancel. '
If .Show = True Then
filecopy([.SelectedItems],[GetDBPath] & "\Images\Equipment\" & Combo153)
Else
End If
End With
End Sub
Using Siddharth routs suggestion, I removed the extra brackets and made a few tweaks and voila! the code worked. I tried engineersmnky method but the pathway wasn't generating correctly. To fix the code itself, the only real error was that on the destination part of the file copy, there was no file name, So I used
Dir(Trim(.SelectedItems.Item(1)
To get the file name and tacked it on the end. Heres the rest of the code for anyone else who wants it.
Private Sub Command156_Click()
Dim fDialog As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim varFile As Variant
' Set up the File Dialog. '
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = Application.CurrentProject.Path
With fDialog
' Allow user to make multiple selections in dialog box '
.AllowMultiSelect = False
' Set the title of the dialog box. '
.Title = "Please select a Image"
' Clear out the current filters, and add our own.'
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the '
' user picked at least one file. If the .Show method returns '
' False, the user clicked Cancel. '
If .Show = True Then
' This section takes the selected image and copy's it to the generated path'
' the string takes the file location, navigates to the image folder, uses the combo box selection to decide the file category, then uses the name from the filedialog to finish the path'
FileCopy .SelectedItems(1), Application.CurrentProject.Path & "\Images\Equipment\" & Combo153 & "\" & Dir(Trim(.SelectedItems.Item(1)))
Else
End If
End With
End Sub
I have answered this question here but I'll repost for you
Here is a concept
Sub Locate_File()
Dim fDialog As Office.FileDialog
Dim file_path As String
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Set the title of the dialog box.
.Title = "Please select one or more files"
'Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
'Show the dialog box. If the .Show method returns True, the
'user picked at least one file. If the .Show method returns
'False, the user clicked Cancel.
If .Show = True Then
file_path = .SelectedItems(1)
Copy_file file_path,Combo153
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End
Sub Copy_file(old_path As String, file_name As String)
Dim fs As Object
Dim images_path As String
images_path = CurrentProject.Path & "\Images\Equipment\"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile old_path, images_path & file_name
Set fs = Nothing
End
You may need to make changes and you must require the Microsoft Office 12.0 Object Library for FileDialog to work. Much of the FileDialog code was taken from Microsoft.

To Add Header and Footer for many word documents?

I have around 100 documents for which the header and footer need to be changed.
Is there a possibility that i can do it just by writing a vba code or Macro in a word file?
Is it possible to give a specific folder in a macro which ll add the header and footer for all the documents in that footer?
the below code gives me
error-5111
Private Sub Submit_Click()
Call openAllfilesInALocation
End Sub
Sub openAllfilesInALocation()
Dim i As Integer
With Application.FileSearch
.NewSearch
.LookIn = "C:\MyFolder\MySubFolder"
.SearchSubFolders = False
.FileName = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
'Open each workbook
Set Doc = Documents.Open(FileName:=.FoundFiles(i))
'Perform the operation on the open workbook
'wb.Worksheets("sheet1").Range("A1") = Date
'Save and close the workbook
With ActiveDocument.Sections(1)
.Headers(wdHeaderFooterPrimary).Range.Text = "Header goes here"
.Footers(wdHeaderFooterPrimary).Range.Text = "Footer goes here"
End With
Doc.Save
Doc.Close
'On to the next workbook
Next i
End With
End Sub
In the code you provided you have tried to use old .FileSearch property. It used to work until MS Office 2003 but not now. Here goes code improved for you. It will open a standard file window where you can pick one or few files to process.
Sub openAllfilesInALocation()
Dim Doc
Dim i As Integer
Dim docToOpen As FileDialog
Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
docToOpen.Show
For i = 1 To docToOpen.SelectedItems.Count
'Open each document
Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i))
With ActiveDocument.Sections(1)
.Headers(wdHeaderFooterPrimary).Range.Text = "Header goes here"
.Footers(wdHeaderFooterPrimary).Range.Text = "Footer goes here"
End With
Doc.Save
Doc.Close
Next i
End Sub

How to take a browsed text file and put it into a list box VBA

So i'm new to using access/VBA and i'm having trouble getting this to work.
Private Sub Get_File_Click()
Dim fdlg As Office.FileDialog
Dim pipe_file As Variant
Dim FileName As String
Dim file As String
Dim fn As Integer
' Clear contents of listboxes and textboxes. '
Me.OrigFile.RowSource = ""
Me.ConvertFile.RowSource = ""
Me.FileName = ""
' Set up the File dialog box. '
Set fdlg = Application.FileDialog(msoFileDialogFilePicker)
With fdlg
.AllowMultiSelect = False
' Set the title of the dialog box. '
.Title = "Select pipe delimited file"
' Clear out the current filters, and then add your own. '
.Filters.Clear
.Filters.Add "Text Files", "*.txt"
' Show the dialog box. If the .Show method returns True, the '
' user picked a file. If the .Show method returns '
' False, the user clicked Cancel. '
If .Show = True Then
file = fdlg
fn = FreeFile
Open file For Input As #fn
Do While Not EOF(fn)
Line Input #fn, pipe_file
Me.OrigFile.AddItem pipe_file
Loop
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
This is what i have so far. origFile is the listbox i'm trying to put the textfile into.
Any help is appreciated
Thanks
Comments added Inline:
Private Sub Get_File_Click()
Dim fdlg As Office.FileDialog
Dim pipe_file As Variant
'Why two vars named 'FileName' and 'file'? Since they are both string, assuming just one of these will do.
Dim FileName As String
'Dim file As String
Dim fn As Integer
'Need variant variable to get file name
Dim varFile As Variant
Me.OrigFile.RowSource = ""
Me.ConvertFile.RowSource = ""
'Don't use ME here. Unless you have an object named FileName (which I'm not sure why you would in this case)
'Me.FileName = ""
FileName = ""
Set fdlg = Application.FileDialog(msoFileDialogFilePicker)
With fdlg
.AllowMultiSelect = False
.Title = "Select pipe delimited file"
.Filters.Clear
.Filters.Add "Text Files", "*.txt"
If .Show = True Then
'Never used this code before but this is how you get the file name:
'Seems lame to have three lines of code to get one file name, but I guess this is the way this control works
For Each varFile In .SelectedItems
FileName = varFile
Next varFile
'The invalid code below was causing the error and it is no longer necessary.
'However, also wanted to point out that you are already in a With block for fldg so the fdlg object is not required
'FileName = fdlg.SelectedItems
fn = FreeFile 'FreeFile = Good!
'Commented out the line below because file is not used
'Open file For Input As #fn
Open FileName For Input As #fn
Do While Not EOF(fn)
Line Input #fn, pipe_file
Me.OrigFile.AddItem pipe_file
Loop
'Make sure to close the file too!
Close #fn
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
Also, one final tip, make sure you have the following line of code declared at the top of your modules:
Option Explicit
This will prevent you from accidentally typing in the name of a variable incorrectly.
You can have the VBA project add this line by default if you click "Tools/Options" and then select "Require Variable Declaration" in the Editor tab.
I think your problem is the line
file = fdlg
should be
file = fdlg.SelectedItems(1)