Outlook VBA add hyperlink of chosen file in dialog - vba

I'm trying to add the functionality in my Outlook (with VBA, I guess is easiest) to add a simple file dialog which takes the path of any files chosen and adds them to the email body as a hyperlink.
The idea of this is for network files to be shared amongst colleagues, instead of attaching them to the email, but just as easy to do.
This is my code so far, I can't even get the dialog to open, and I've had a good look at trying to get COMDLG32.ocx, so far I can't seem to make anything work.
Sub Main2()
Dim CDLG As Object
Set CDLG = CreateObject("MSComDlg.CommonDialog")
With CDLG
.DialogTitle = "Get me a File!"
.Filter = _
"Documents|*.doc|Templates|*.dot|Text Files|*.txt"
.ShowOpen
MsgBox .FileName
End With
Set CDLG = Nothing
End Sub
Thanks in advance, hopefully someone can show me how this is done!
Just for those who need it; OS Windows 10, Office 2010 H&B (yes, I know it's out of date :))

There seems to be no direct way to open a FileDialog in Outlook 2010 VBA.
The following macro (inspired by a related post) makes use of Excel to circumvent this:
Public Function promptFileName(title As String, filter As String) As String
' requires project reference to "Microsoft Excel 14.0 Object Library"
Dim xlObj As Excel.Application
Dim fd As Office.FileDialog
Dim name As String
Dim vItem As Variant
Dim filterArray() As String
Dim i As Integer
Set xlObj = New Excel.Application
xlObj.Visible = False
Set fd = xlObj.Application.FileDialog(msoFileDialogOpen)
name = ""
With fd
.title = title
.ButtonName = "Ok"
.Filters.Clear
filterArray = Split(filter, "|")
For i = LBound(filterArray) To UBound(filterArray) - 1 Step 2
.Filters.Add filterArray(i), filterArray(i + 1), 1 + i \ 2
Next i
If .Show = -1 Then
For Each vItem In .SelectedItems
name = vItem
Exit For
Next
End If
End With
xlObj.Quit
Set xlObj = Nothing
promptFileName = name
End Function
Private Sub testPromptFile
Dim name as String
name = promptFileName("a test", "Text Files (*.txt)|*.txt|All Files (*.*)|*.*")
MsgBox name
End Sub
Outlook 2013 and beyond provide an Office.FileDialog class for this purpose.

You can press a button with Outlook VBA.
Sub ExecuteMso_strId()
Dim objItem As Object
Dim strId As String
' Text appears when hovering over icon
' when adding buttons to a Quick Access toolbar or a ribbon
strId = "HyperlinkInsert"
On Error Resume Next
Set objItem = ActiveInspector.currentItem
On Error GoTo 0
If Not objItem Is Nothing Then
ActiveInspector.CommandBars.ExecuteMso (strId)
Else
ActiveExplorer.CommandBars.ExecuteMso (strId)
End If
End Sub
With this you do not have access to the parameters as with Excel.

Related

Word Window Type mismatch

I am trying to capture pages in word as image and paste in Excel via VBA, below is the complete code. but got a Type Mismatch error as the comment in below. How to fix the error?
Function openFile() As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Word Files", "*.doc*", 1
.Show
openFile = .SelectedItems.Item(1)
End With
End Function
Function readWord(ByVal path As String)
Debug.Print "Read word", path
Set objWordApp = CreateObject("Word.Application")
Set objWordDoc = objWordApp.Documents.Open(path)
objWordApp.Visible = False
Dim objPage As Page
Dim objPane As Pane
Dim objWindow As Window
Debug.Print objWordDoc.Windows.Count
Debug.Print TypeName(objWordDoc.Windows.Item(1))
For Each objWindow In objWordDoc.Windows 'Got Type mismatch Here
For Each objPane In objWindow.Panes
For Each objPage In objPane.Pages
Debug.Print "Page"
Next objPage
Next objPane
Next objWindow
End Function
Sub processWord()
Dim p As String
p = openFile()
readWord (p)
End Sub
The error is caused because your code contains a confused mess of objects.
You are attempting to use late binding for Word and yet you declare:
Dim objPage As Page
Dim objPane As Pane
Dim objWindow As Window
As you appear to be writing your code in Excel this results in these objects being:
Dim objPage As Excel.Page
Dim objPane As Excel.Pane
Dim objWindow As Excel.Window
This causes the type mismatch error.
I suggest that you avoid using late binding until you have your code fully working. Then you can change all the object declarations to As Object, if you really feel it is necessary.
Incidentally, if you are thinking that you can use the SaveAsPNG method listed in the documentation to get images of the documents pages, you can't - it doesn't exist.

Open Windows Explorer from Outlook to choose template [duplicate]

This question already has answers here:
Filepicker VBA to select file and store the file name not working
(2 answers)
Closed 3 years ago.
I am trying to write a macro that allows a user to select a .oft from a directory. I have been able to get a simple macro working that will open a specific .oft and modify the "from" field - this is what I have so far.
Sub EmailTemplateW10()
Set msg = Application.CreateItemFromTemplate("c:\test\test.oft")
msg.SentOnBehalfOfName = "user#domain.com"
msg.Display
Set msg = Nothing
End Sub
That works great, but there are numerous .oft files in the directory I am working with. I did find some articles that talk about setting up a toolbar with drop-downs and creating a macro for each .oft in the directory. I assume there has to be a better way than making a macro for each template.
I tried using this :
Sub EmailTemplateW10()
Set msg = Application.CreateItemFromTemplate(Demo)
msg.SentOnBehalfOfName = "user#domain.com"
msg.Display
Set msg = Nothing
End Sub
Function Demo()
Call Shell("explorer.exe" & " " & "C:\test\", vbNormalFocus)
End Function
Windows Explorer will come up - but the macro throws an error and stops when you acknowledge the error.
Is there perhaps some way to have the user select the file through explorer.exe and save the path of the selected file to a variable, and then pipe that into .CreateItemFromTemplate?
After some digging around I got this to work. I am obviously a VBA noob so i take no credit for the code - I was just able to mash it together and get it to work. Maybe someone in the future will find it helpful.
Public Function aBrowseForFile(aStartFolder As String) As String
On Error GoTo Err_txtBrowseForFile
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Dim fDialog As Office.FileDialog
Dim varfile As Variant
Dim strPath As String
Dim strFilter As String, strFileName As String
Dim Main_Dir As String, DefFolder As String
Set fDialog = xlApp.Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.InitialView = msoFileDialogViewThumbnail
.AllowMultiSelect = False
.Title = "Please select one or more files"
.InitialFileName = aStartFolder
.InitialView = msoFileDialogViewThumbnail
.Filters.Clear
.Filters.Add "all files", "*.*"
If .Show = True Then
aBrowseForFile = .SelectedItems(1)
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
Exit_txtBrowseForFile:
Exit Function
Err_txtBrowseForFile:
MsgBox Err.Description, vbCritical, "MyApp"
Resume Exit_txtBrowseForFile
End Function
Sub EmailTemplateW10()
Dim MyFileURL As String
MyFileURL = aBrowseForFile("C:\users\")
Set msg = Application.CreateItemFromTemplate(MyFileURL)
msg.SentOnBehalfOfName = "user#domain.com"
msg.Display
Set msg = Nothing
End Sub

How do I call this subroutine from a button click on an Access form?

So, dumb question, but I can't figure it out. I have the following code that searches for a file path name and I believe adds the record to a table (untested). But, the problem is I am unable to Call this subroutine. I'd like to be able to click a button on a form and run. Does anyone know how I do this? thank you!
Public Function SelectFile() As String
Dim f As FileDialog
Set f = Application.FileDialog(msoFileDialogOpen)
With f
.AllowMultiSelect = False
.Title = "Please select file to attach"
If .Show = True Then
SelectFile = .SelectedItems(1)
Else
Exit Function
End If
End With
Set f = Nothing
End Function
Public Sub AddAttachment(ByRef rstCurrent As DAO.Recordset, ByVal strFieldName As String, ByVal strFilePath As String)
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
'Ask the user for the file
Dim filepath As String
filepath = SelectFile()
'Check that the user selected something
If Len(filepath) = 0 Then
Debug.Assert "No file selected!"
Exit Sub
End If
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Table1")
''''change this
'Add a new row and an attachment
rst.AddNew
AddAttachment rst, "Files", filepath
rst.Update
'Close the recordset
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Sub
You would add an event procedure to the button in question:
In Form Design mode, click on the button
In the Properties Sheet, select the builder [...] button of the On Click event
You will go to the VBA editor. Enter code like:
Private Sub cmdAddAttachment_Click()
AddAttachment Nothing, "", ""
End Sub
That said, your AddAttachment routine has an apparent infinite loop. The line:
AddAttachment rst, "Files", filepath
Doesn't seem to actually fill any field values. In fact, variables rstCurrent, strFieldName and strFilePath are not used in the code. You probably will need to debug this routine before it will work.

MS Access 2010 - How can I tie an entry text box to a VBA command that opens a MS Word file based on user's entry?

Option Compare Database
Function Openword(conPath As String)
Dim appword As Word.Application
Dim doc As Word.Document
On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
Set doc = appword.Documents.Open(conPath, , True)
appword.Activate
Set doc = Nothing
Set appword = Nothing
End Function
Private Sub Command5_Click()
Dim mydoc As String
mydoc = "J:\3 - Client Services\1-Programs\12229709.docx"
Call Openword(mydoc)
End Sub
So far I have made the code that will open a specific file when the button on the form is clicked. However, there are a ton of these files that the user needs to be able to select and open. To keep it simple, I want them to be able to open the Word file by simply typing in the name of the file and clicking a button that will find and open it. The name of the file in the example above is simply 12229709.docx, but there are other files similar to it (e.g. 12172029, 12124057...) all in the same location. I want there to be a text box where the user can enter in the number and the button will check that specific folder for a file name with that number in it (without having to add the ".docx" if possible). How do I go about doing this?
EDIT - I forgot to mention that I cannot show the file path or use a file dialog box to allow the user to pick the file because the users that will be choosing the file do not have authorization to access this part of the network.
Try this out
Dim MyValue as Variant
MyValue = Inputbox("Enter File Name")
Dim MyDoc as String
MyDoc = "J:\3 - Client Services\1-Programs\" & MyValue & ".docx"
Call OpenWord(MyDoc)
Not sure if that is what you are looking for but I hope it helps.
I don't know why you'd want to make your user type in a file name when you can just open a file dialog and have them click on the right file.
Just put a command button on your form and include a line "Application.FollowHyperlink" plus this function name. The computer file associations can take care of the rest.
Sub Command()
Application.FollowHyperlink FileName()
End Sub
Public Function FileName() As String
Dim f As Object
' Must have object reference set to a MS Office Object Library for this to work.
Set f = Application.FileDialog(msoFileDialogFilePicker)
With f
.AllowMultiSelect = False
If .Show = -1 Then
FileName = .SelectedItems(1)
End If
End With
FileName = Nz(FileName, "")
End Function

using Application.FileDialog to rename a file in VBA

Using VBA. My script moves a file into a directory. If that filename already exists in the target directory, I want the user to be prompted to rename the source file (the one that's being moved) before the move is executed.
Because I want the user to know what other files are in the directory already (so they don't choose the name of another file that's already there), my idea is to open a FileDialog box listing the contents of the directory, so that the user can use the FileDialog box's native renaming capability. Then I'll loop that FileDialog until the source file and target file names are no longer the same.
Here's some sample code:
Sub testMoveFile()
Dim fso As FileSystemObject
Dim file1 As File
Dim file2 As File
Dim dialog As FileDialog
Set fso = New FileSystemObject
fso.CreateFolder "c:\dir1"
fso.CreateFolder "c:\dir2"
fso.CreateTextFile "c:\dir1\test.txt"
fso.CreateTextFile "c:\dir2\test.txt"
Set file1 = fso.GetFile("c:\dir1\test.txt")
Set file2 = fso.GetFile("c:\dir2\test.txt")
Set dialog = Application.FileDialog(msoFileDialogOpen)
While file1.Name = file2.Name
dialog.InitialFileName = fso.GetParentFolderName(file2.Path)
If dialog.Show = 0 Then
Exit Sub
End If
Wend
file1.Move "c:\dir2\" & file1.Name
End Sub
But when I rename file2 and click 'OK', I get an error:
Run-time error '53': File not found
and then going into the debugger shows that the value of file2.name is <File not found>.
I'm not sure what's happening here--is the object reference being lost once the file's renamed? Is there an easier way to let the user rename from a dialog that shows all files in the target directory? I'd also like to provide a default new name for the file, but I can't see how I'd do that using this method.
edit: at this point I'm looking into making a UserForm with a listbox that gets populated w/ the relevant filenames, and an input box with a default value for entering the new name. Still not sure how to hold onto the object reference once the file gets renamed, though.
Here's a sample of using Application.FileDialog to return a filename that the user selected. Maybe it will help, as it demonstrates getting the value the user provided.
EDIT: Modified to be a "Save As" dialog instead of "File Open" dialog.
Sub TestFileDialog()
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = "D:\Temp\Testing.txt" ' Set suggested name for user
' This could be your "File2"
If Dlg.Show = -1 Then
Dim s As String
s = Dlg.SelectedItems.Item(1) ` Note that this is for single-selections!
Else
s = "No selection"
End If
MsgBox s
End Sub
Edit two: Based on comments, I cobbled together a sample that appears to do exactly what you want. You'll need to modify the variable assignments, of course, unless you're wanting to copy the same file from "D:\Temp" to "D:\Temp\Backup" over and over. :)
Sub TestFileMove()
Dim fso As FileSystemObject
Dim SourceFolder As String
Dim DestFolder As String
Dim SourceFile As String
Dim DestFile As String
Set fso = New FileSystemObject
SourceFolder = "D:\Temp\"
DestFolder = "D:\Temp\Backup\"
SourceFile = "test.txt"
Set InFile = fso.GetFile(SourceFolder & SourceFile)
DestFile = DestFolder & SourceFile
If fso.FileExists(DestFile) Then
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = DestFile
Do While True
If Dlg.Show = 0 Then
Exit Sub
End If
DestFile = Dlg.Item
If Not fso.FileExists(DestFile) Then
Exit Do
End If
Loop
End If
InFile.Move DestFile
End Sub
Here's some really quick code that I knocked up but basically looks at it from a different angle. You could put a combobox on a userform and get it to list the items as the user types. Not pretty, but it's a start for you to make more robust. I have hardcoded the directory c:\ here, but this could come from a text box
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
Dim varListing() As Variant
Dim strFilename As String
Dim strFilePart As String
Dim intFiles As Integer
ComboBox1.MatchEntry = fmMatchEntryNone
strFilePart = ComboBox1.Value
strFilename = Dir("C:\" & strFilePart & "*.*", vbDirectory)
Do While strFilename <> ""
intFiles = intFiles + 1
ReDim Preserve varListing(1 To intFiles)
varListing(intFiles) = strFilename
strFilename = Dir()
Loop
On Error Resume Next
ComboBox1.List() = varListing
On Error GoTo 0
ComboBox1.DropDown
End Sub
Hope this helps. On error resume next is not the best thing to do but in this example stops it erroring if the variant has no files