So I am trying to create a code to expedite inserting a hyperlink in Outlook.
I am trying to have it so that if I have already copied a path, I can just go in and type Ctrl W and it will insert the hyperlink for the word here. My attempt at the code is:
Sub InsertHyperlink()
'
'
'
On Error Resume Next
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"U:\plot.log", _
SubAddress:="", ScreenTip:="", TextToDisplay:="here"
End Sub
I am having issues on how to update my code so that will work in Outlook (I programmed it in Word) and so that the "U:\plot.log" would actually be the copied path (not the copied path when I recorded the macro).
Does anyone have any suggestions?
Set your references to Word object Library
Tools > References > add Word object Library
Option Explicit
Sub Add_Hyperlinks()
Dim olNameSpace As Outlook.NameSpace
Dim wDoc As Word.Document
Dim rngSel As Word.Selection
If Application.ActiveInspector.EditorType = olEditorWord Then
Set wDoc = Application.ActiveInspector.WordEditor ' use WordEditor
Set olNameSpace = Application.Session
Set rngSel = wDoc.Windows(1).Selection ' Current selection
wDoc.Hyperlinks.Add rngSel.Range, _
Address:="U:\plot.log", TextToDisplay:="Here is the link"
End If
Set wDoc = Nothing
Set olNameSpace = Nothing
End Sub
Thank you so much for the help, I really appreciate it! So I made a slight variation to your code to try and get it to paste whatever is on the clipboard.
My new code is as follows. Do I need to add in any error trapping? Also, what does the option explicit exactly do?
Option Explicit
Sub Add_Hyperlinks()
Dim olNameSpace As Outlook.NameSpace
Dim wDoc As Word.Document
Dim rngSel As Word.Selection
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
If Application.ActiveInspector.EditorType = olEditorWord Then
Set wDoc = Application.ActiveInspector.WordEditor ' use WordEditor
Set olNameSpace = Application.Session
Set rngSel = wDoc.Windows(1).Selection ' Current selection
wDoc.Hyperlinks.Add rngSel.Range, _
Address:=DataObj.GetText(1), TextToDisplay:="here"
End If
Set wDoc = Nothing
Set olNameSpace = Nothing
End Sub
Related
I would like add a working checkbox (content control?) to an existing task, like a list of sub-tasks, that could just be checked off.
Within Outlook I referenced the Microsoft Word 16.0 Object Library, and I have tried the suggestions at http://www.vboffice.net/en/developers/use-word-macro-in-outlook/ and https://www.slipstick.com/developer/word-macro-apply-formatting-outlook-email/ without success.
I tried
Option Explicit
Public Sub Checkbox()
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' Add reference to Word library
' in VBA Editor, Tools, References
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
On Error Resume Next
' Reference the current Outlook item
Set objItem = Application.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
' Formatting code goes here
Selection.Range.ContentControls.Add (wdContentControlCheckBox)
End If
End If
End If
Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objInsp = Nothing
End Sub
I have also tried
Public Sub Check2()
Dim Ins As Outlook.Inspector
Dim Document As Word.Document
Dim Word As Word.Application
Dim Selection As Word.Selection
Set Ins = Application.ActiveInspector
Set Document = Ins.WordEditor
Set Word = Document.Application
Set Selection = Word.Selection
Selection.Range.ContentControls.Add (wdContentControlCheckBox)
End Sub
The first one didn't do anything, as I recall.
The second one showed
Run-time error '445'".
Object doesn't support this action
Your VBA code works correctly:
Public Sub Check2()
Dim Ins As Outlook.Inspector
Dim Document As Word.Document
Dim Word As Word.Application
Dim Selection As Word.Selection
Set Ins = Application.ActiveInspector
Set Document = Ins.WordEditor
Set Word = Document.Application
Set Selection = Word.Selection
Selection.Range.ContentControls.Add (wdContentControlCheckBox)
End Sub
You just needed to add a reference to the Word object library (Tools -> References):
My goal is copy and past body of active email from Outlook to the MS Word, and save Word to specified destination.
Code
Dim objMail as Outlook.MailItem
Dim objWord As Object
Dim objDocument As Object
Dim objFSO As Object
Dim objTextStream As Object
Set objMail = Application.ActiveInspector.CurrentItem
Set objWord = CreateObject("Word.Application")
Set objDocument = objWord.Documents.Add
objMail.GetInspector().WordEditor.Range.FormattedText.Copy
objDocument.Range.Paste
Its a right way ?
You can check, if you really selected an email (either within the list or opened) and copy its formatted body like this:
Private Sub CopyEMailBodyToWord()
Dim objOutlook As Outlook.Application
Dim objMail As Object 'Outlook.MailItem, but has to be checked later
Dim objWord As Object
Dim objDocument As Object
Set objOutlook = Outlook.Application
Select Case TypeName(objOutlook.ActiveWindow)
Case "Explorer" ' get current item in list view
Set objMail = objOutlook.ActiveExplorer.Selection.Item(1)
Case "Inspector" ' get open item
Set objMail = objOutlook.ActiveInspector.CurrentItem
End Select
If objMail.Class = olMail Then
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then Set objWord = CreateObject("Word.Application")
Set objDocument = objWord.Documents.Add
' copy formatted body:
objMail.GetInspector.WordEditor.Range.FormattedText.Copy
objDocument.Range.Paste
' or copy text only:
'objDocument.Range.Text = objMail.Body
With objWord.FileDialog(msoFileDialogSaveAs)
.Title = "Save ..."
.InitialFileName = objWord.Options.DefaultFilePath(wdDocumentsPath) & _
"\" & objMail.Subject & ".docx"
If .Show <> False Then
objDocument.SaveAs _
FileName:=.SelectedItems(1), _
AddToMru:=False
End If
End With
End If
End Sub
Is this what you are trying to do?
Option Explicit
Public Sub Example()
Dim Email As Outlook.MailItem
Set Email = Application.ActiveInspector.CurrentItem
'Word document
Dim wdApp As Word.Application
Set wdApp = CreateObject("Word.Application")
Dim wdDoc As Word.Document
Set wdDoc = wdApp.Documents.Add
wdDoc.Activate
Dim wdRange As Word.Range
Set wdRange = wdDoc.Range(0, 0)
'Add email to the document
wdRange.Text = Email.Body
wdApp.Visible = True
wdDoc.SaveAs2 FileName:="C:\Temp\Example.docx", FileFormat:= _
wdFormatXMLDocument, CompatibilityMode:=15
End Sub
You may also wanna work with ActiveWindow.Class to avoid any error on your CurrentItem
This script worked perfectly... until it didn't. I have an Excel workbook in the same folder as multiple copies of a Word form. The macro should pull the data from each form and copy it to a row in the workbook. I now get either "OLE Excel is waiting on another application" errors or Runtime 438 errors. The macro I use is as follows:
Sub GetFormData()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.docm", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
j = 0
For Each CCtrl In .ContentControls
j = j + 1
WkSht.Cells(i, j).FormulaLocal = CCtrl.Range.Text
Next
End With
wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
The issue appears to start at "Set wdDoc = wdApp..."
I am a bit of a noob at this. As such, I appreciate your help.
Matt.
I see two possible issues, the first one is almost certainly causing the error; the second could cause this error (but probably not with VBA):
You declare and instantiate the Word application in the same line:
Dim wdApp As New Word.Application
You shouldn't do this. Instead:
Dim wdApp As Word.Application
Set wdApp = New Word.Application
I don't remember the exact details about the "why", but it's something to do with the Word.Application object being created immediately, and at a level where you can no longer control it using Set wdApp = Nothing.
Correctly, all objects of the "outside" application should be released, in reverse order of their creation. You've declared an object of the type Word.ContentControl, but don't release it:
Set Set CCtrl = Nothing : Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
I get error
user-defined type not defined
in the Function GetOutlookApp() As Outlook.Application.
Sub CreateAppointments()
Dim cell As Excel.Range
Dim rng As Excel.Range
Dim wholeColumn As Excel.Range
Dim startingCell As Excel.Range
Dim oApp As Outlook.Application
Dim tsk As Outlook.TaskItem
Dim wkbk As Excel.Workbook
Dim wksht As Excel.Worksheet
Dim lastRow As Long
Dim arrData As Variant
Dim i As Long
' start Outlook app
Set oApp = GetOutlookApp
If oApp Is Nothing Then
MsgBox "Could not start Outlook.", vbInformation
Exit Sub
End If
' get worksheet range into an array in one go
Set wkbk = ActiveWorkbook
Set wksht = wkbk.ActiveSheet
Set wholeColumn = wksht.Range("B:B")
lastRow = wholeColumn.End(xlDown).Row - 2
Set startingCell = wksht.Range("B2")
Set rng = wksht.Range(startingCell, startingCell.Offset(lastRow, 1))
arrData = Application.Transpose(rng.Value)
' loop through array and create tasks for each record
For i = LBound(arrData, 2) To UBound(arrData, 2)
Set tsk = oApp.CreateItem(olTaskItem)
With tsk
.DueDate = arrData(2, i)
.Subject = arrData(1, i)
.Save
End With
Next I
End Sub
Function GetOutlookApp() As Outlook.Application
On Error Resume Next
Set GetOutlookApp = CreateObject("Outlook.Application")
End Function
The How to automate Outlook from another program article describes all the required steps for automating Outlook. It states:
To use early binding, you first need to reference the available Outlook object library. To do this from Visual Basic (VB) or Visual Basic for Applications, follow these steps:
In the Visual Basic Editor, on the Tools menu, click References.
Click to select the Microsoft Outlook 15.0 Object Library check box, and then click OK.
I was have the same problem when I use Outlook in my scripts VBA Excel and I select:
Tools > References > Check the checkbox in front of "Microsoft Outlook 15.0 Object Library.
This macro adds hyperlink to email :
Sub test_add_hyperlink()
Dim NewMail As Outlook.MailItem
Set NewMail = Application.ActiveInspector.CurrentItem
NewMail.HTMLBody = "<HTML><BODY><A href=http://www.someaddress.com>URL_TEXT</A></BODY></HTML>" & NewMail.HTMLBody End Sub
but how to add hyperlink in place where active cursor is ? I ask beacause I would like to add hyperlink not at the front of message, but where my currently writing message.
The hyperlink I would like to add is the hyperlink to file which is currently copied to Windows' clipboard, this part I've written, but I can't figure out how to place it not at the front of email, but in place where active cursor is. I think that macro based emulation of Windows' keypressing is one of the directions to follow.
This describes how to paste at the selection.
http://www.slipstick.com/developer/code-samples/paste-formatted-text-vba/
Sub PasteFormattedClipboard()
Dim objItem As Object
Dim objInsp As Outlook.Inspector
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Set objItem = Application.ActiveInspector.CurrentItem
Set objInsp = objItem.GetInspector
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
objSel.PasteAndFormat (wdFormatOriginalFormatting)
Set objItem = Nothing
Set objInsp = Nothing
Set objDoc = Nothing
Set objWord = Nothing
Set objSel = Nothing
End Sub
Sub InsertHyperlinkAtCursorPositon()
On Error GoTo finish
strLink = "http://www.outlookcode.com"
strLinkText = "Get Outlook code samples here"
Set objInsp = Application.ActiveInspector
Set objMsg = objInsp.CurrentItem
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Windows(1).Selection
If objMsg.BodyFormat <> olFormatPlain Then
objDoc.Hyperlinks.Add objSel.Range, strLink, _
"", "", strLinkText, ""
Else
objSel.InsertAfter strLink
End If
finish:
End Sub