Hi I am new to VBA and I am trying to insert InputBox text into a word document. In this case just printing the asked first and last name via the InputBox into the document. I need to base the sub procedure from the line:
strFull = strFirstName & " " & strLastName
My current sub procedure just ends up printing "strFull" in a new word document instead of the InputBox First and Last name. What am i doing wrong? My code is below:
Public Sub Insert_Name_Into_Word()
'Set wd as the object variable for Word and store the address as Word.Application'
Dim wd As Word.Application
'Set doc as the object variable and store the address as Word.Document'
Dim doc As Word.Document
'Set para as the object variable and store the address as Word.Pargraph'
Dim para As Word.Paragraph
'Set strFirstName as the object variable for a string, Same for strLastName, and for strFull as well'
Dim strFirst As String, strLast As String, strFull As String
'Set the address of wd create a new word application'
Set wd = New Word.Application
'Set the address of doc to create a new document in a new word application window'
Set doc = wd.Documents.Add
'Make the new Word Application visible'
wd.Visible = True
'make stored variable an input box response for entering name'
strFirst = InputBox(prompt:="Enter Your Name:", Title:="FirstName")
'declare last name in input box'
strLast = InputBox(prompt:="Enter Your Last Name:", Title:="Last Name")
'Identify strFull as strFirst plus strLast'
strFull = strFirstName & " " & strLastName
'make the address of para a creation of a new paragraph in doc'
Set para = doc.Paragraphs.Add
'make para's text to InputBox outputs'
para.Range.Text = "strFull"
End Sub
Use:
para.Range.Text = strFull
not:
para.Range.Text = "strFull"
Related
Problem:
I want to type a paragraph of text, add my short signature + date + time and format everything so another person would see I added this comment to the mail.
Example:
This is my personal comment on the topic // Signature Tom, 22.08.21, 14:00 (<- add the last part by VBA-Code and put this whole paragraph in red and italic by VBA)
Dear Sir or Madam
...-> mail body
Sincerely
What I have
So far it is two separate VBA sub routines I managed to create with trial and error from the web, but I would like it in one step (because I have to call them one after a time).
1st:
Option Explicit
Public Sub AddShortSignature()
Dim xDoc As Object
Dim xSel As Object
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set xDoc = Application.ActiveExplorer.Selection(1).GetInspector.WordEditor
Case "Inspector"
Set xDoc = Application.ActiveInspector.WordEditor
End Select
Set xSel = xDoc.Application.Selection
xSel.InsertBefore Format(Now, "DD/MM/YYYY hh/mm")
xSel.InsertBefore Format(" // Tom., ")
Set xDoc = Nothing
Set xSel = Nothing
SendKeys "{End}", True
SendKeys "+{Home}", True
End Sub
and 2nd, format everything to my liking:
Sub formateverything()
Dim objDoc As Object
Dim objSel As Object
Set objDoc = ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
objSel.Font.Name = "Arial"
objSel.Font.Italic = True
objSel.Font.Bold = False
objSel.Font.Underline = False
objSel.Font.Color = RGB(0, 0, 0)
objSel.Font.Size = 14
End Sub
As I can see in your pictures, your comment and signature comes at the top of the mail (first paragraph), so this is what I came up with.
Public Sub OutlookMail_CommentAndSignature()
Dim Ins As Outlook.Inspector
Dim Doc As Object
Dim mySignature As String
Dim oPara As Object ' paragraph
Dim paraText As String ' paragraph text
Dim paraLength As Integer ' paragraph length
Set Ins = Application.ActiveInspector
Set Doc = Ins.WordEditor
' Signature
mySignature = " // Tom., " & Format(Now, "DD/MM/YYYY hh:mm") & vbCrLf
' ' First paragraph: comment + signature
' Set oPara = Doc.Paragraphs(1).Range
' paraLength = Len(oPara.Text)
' oPara.Text = Left(oPara.Text, paraLength - 1) ' without vbCrLf
' oPara.Text = oPara.Text & mySignature
' ' format first paragraph
' oPara.Font.Italic = wdToggle
' oPara.Font.ColorIndex = wdRed
' Selected text
Dim selRange As Object: Set selRange = Doc.Application.Selection.Range
' set text range to italic and red
selRange.InsertAfter mySignature
' format first paragraph
selRange.Font.Italic = wdToggle
selRange.Font.ColorIndex = wdRed
End Sub
This code sets the cursor to the end position of the message field, and the inserts a 'signature'. With this you set whatever position you want.
Public Sub OutlookMail_SetCursorAT()
Dim Ins As Outlook.Inspector
Dim Doc As Object
Dim Range As Object
Dim Pos As Long
Set Ins = Application.ActiveInspector
Set Doc = Ins.WordEditor
' Set the cursor to the end position of the message field
If Not Doc Is Nothing Then
Pos = Doc.Range.End - 1
Set Range = Doc.Range(Pos, Pos)
Range.Select
End If
' Signature
Dim mySignature As String
mySignature = vbCrLf & Format(" // Tom., ")
mySignature = mySignature & vbCrLf & Format(Now, "DD/MM/YYYY hh/mm")
Range.InsertAfter mySignature
End Sub
I hired someone to write code which does the following when an email is highlighted.
FW Email
Insert already copied item from clipboard and paste in To Field (the copied email address)
Remove FW: from Subject line
Remove everything above the original message which includes the original email info/date/address etc.
It leaves a blank line above the first word of the body which is "Hello Name".
How can I delete that empty row so "Hello Name" is at the top of the email OR delete the "Hello Name" alltogether?
Sub ForwardFromClipboard2()
Dim tmpEmail As MailItem
Dim fwEmail As MailItem
For Each Item In Application.ActiveExplorer.Selection
If TypeName(Item) = "MailItem" Then
Set tmpEmail = Item.Forward
tmpEmail.Subject = Item.Subject
tmpEmail.To = GetClipBoardText
tmpEmail.Display
RemoveSign (tmpEmail.Subject)
Set tmpEmail = Nothing
End If
Next
End Sub
Sub RemoveSign(MySubject As String)
Dim objOL As Application
Dim objDoc As Object
Dim objSel As Object
Set objOL = Application
Set objDoc = objOL.ActiveInspector.WordEditor
Set objSel = objDoc.Application.Selection
' delete signature
If objDoc.Bookmarks.Exists("_MailOriginal") Then
Set objBkm = objDoc.Bookmarks("_MailOriginal")
objSel.Start = 0
objSel.End = objBkm.Start
objDoc.Windows(1).Selection.Delete
End If
' delete FROM:, TO:, SUBJECT:
Dim search As String
search = "Subject:"
Dim search2 As String
search2 = MySubject
For Each para In objDoc.Paragraphs
Dim txt As String
txt = para.Range.Text
If InStr(txt, search) Or InStr(txt, search2) Then
para.Range.Delete
Exit For
End If
Next
End Sub
Function GetClipBoardText() As String
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
On Error GoTo Whoa
DataObj.GetFromClipboard
myString = DataObj.GetText(1)
GetClipBoardText = myString
Exit Function
Whoa:
GetClipBoardText = ""
End Function
You can use the HTMLBody or the Word object model to edit the message body according to your needs. The Word object model provides the Delete method of the Range class which deletes the specified number of characters or words. See Chapter 17: Working with Item Bodies for more information.
How to iterate through each and every heading name in (table of contents) and extract their associated data content (both text & non text ) from word document using VBA ?
For example, consider attached picture, how will I be able to extract the data contents (arrows pointed to the required 3 data contents) corresponding to a specific heading name "4.1.7.3 Description of Roles "?
In the attached picture , list of headings(table of contents) are displayed in the left panel, when we click on any specific toc item then it's corresponding data will be displayed in the right panel/section.
Currently, I am able access each heading content with below provided code .
Please guide me on how to extract their associated data content ( both text & non text ) with VBA code.
Sub Main()
Dim strFile As String
Dim oWord As Word.Application
Dim oWdoc As Word.Document
Dim oPar As Word.Paragraph
Dim rng As Word.Range
strFile = "C:\Users\SQVA\Desktop\My_Work\MyTest3.docx"
'Set oWord = CreateObject("Word.Application")
Set oWord = New Word.Application
Set oWdoc = oWord.Documents.Open(strFile)
Call Get_Heading_Name(oWord, oWdoc, strFile, rng)
Call Close_Word(oWord, oWdoc)
End Sub
Sub Get_Heading_Name(oWord As Word.Application, oWdoc As Word.Document, strFile As String, rng As Word.Range)
oWord.Visible = True
Dim astrHeadings As Variant
Dim strText As String
Dim intItem As Integer
Set rng = oWdoc.Content
astrHeadings = _
oWdoc.GetCrossReferenceItems(wdRefTypeHeading)
For intItem = LBound(astrHeadings) To UBound(astrHeadings)
strText = Trim$(astrHeadings(intItem))
Debug.Print CStr(strText)
Next intItem
End Sub
Sub Close_Word(oWord As Word.Application, oWdoc As Word.Document)
oWdoc.Close SaveChanges:=wdDoNotSaveChanges
oWord.Quit
Set oWdoc = Nothing
Set oWord = Nothing
End Sub
I am writing a program that is supposed to merge several word documents into one keeping the formatting of each document. After some research on the web wrote a version that is supposed to work, which is the following:
Public Sub processmodulestest(ByVal id As Integer)
Dim oMissing = System.Reflection.Missing.Value
Dim oFalse = False
Dim oTrue = True
Dim fileDirectory = "C:\<file-path>\MOD-TEST\"
Dim wrdApp As New Word.Application
Dim destDoc As Word.Document 'destination doc
Dim docfile As Word.Document 'tmp doc to paste
destDoc = wrdApp.Documents.Add
'docNew.PageSetup.TopMargin = wrdApp.InchesToPoints(1.0F)
'docNew.PageSetup.BottomMargin = wrdApp.InchesToPoints(0.0F)
Dim wordFiles() As String = Directory.GetFiles(fileDirectory, "*.doc")
wrdApp.Options.Pagination = False
wrdApp.ActiveWindow.View.ShowAll = True
For Each el As String In wordFiles
docfile = wrdApp.Documents.Open(el, False, False)
wrdApp.Selection.WholeStory()
wrdApp.Selection.Copy()
wrdApp.ActiveWindow.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
destDoc.Activate()
wrdApp.Selection.PasteAndFormat(Word.WdRecoveryType.wdFormatOriginalFormatting)
wrdApp.Selection.InsertBreak(Word.WdBreakType.wdPageBreak)
Next
wrdApp.Visible = True
End Sub
I get the following Error:
An unhandled exception of type'System.Runtime.InteropServices.COMException'
HRESULT: 0x80010108 (RPC_E_DISCONNECTED)) The object invoked has disconnected from its clients.
referring to the following line:
destDoc.Activate()
I read that this should be because the code uses an unqualified method on an Office instance that has been ended, but i can't understand how to fix it
I'm not sure how to do it in VB.NET, but the VBA code below will merge all Word documents into one single consolidated Word document.
Appending multiple Word docs into a single Word doc
Sub Foo()
Dim i As Long
Dim MyName As String, MyPath As String
Application.ScreenUpdating = False
Documents.Add
MyPath = "C:\Documents and Settings\Excel\Desktop\Word Files\" ' <= change this as necessary
MyName = Dir$(MyPath & "*.doc") ' not *.* if you just want doc files
Do While MyName <> ""
If InStr(MyName, "~") = 0 Then
Selection.InsertFile _
FileName:="""" & MyPath & MyName & """", _
ConfirmConversions:=False, Link:=False, _
Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
End If
MyName = Dir ' gets the next doc file in the directory
Loop
End Sub
Here's my code below, my problem is i want to put my desired filename when creating an document.. But i don't know how. Can you help me.
Here's my code:
Dim oWord As Word.Application
Dim odoc As Word.Document
Dim oWModule As VBIDE.VBComponent
Dim sCode As String
Dim oCommandBar As Office.CommandBar
Dim oCommandBarButton As Office.CommandBarControl
' Create an instance of Word, and show it to the user.
oWord = New Word.Application()
' Add a Document.
odoc = oWord.Documents.Add
' Create a new VBA code module.
oWModule = odoc.VBProject.VBComponents.Item("ThisDocument")
sCode = "Sub FileSaveAs" & vbCr & _
" msgbox ""Save As has been Disabled!"" " & vbCr & _
"end sub"
' Add the VBA macro to the new code module.
oWModule.CodeModule.AddFromString(sCode)
oWord.Visible = True
' Set the UserControl property so that Excel does not shut down.
'oWord.UserControl = True
' Release the variables.
oCommandBarButton = Nothing
oCommandBar = Nothing
oWModule = Nothing
odoc = Nothing
oWord = Nothing
' Force garbage collection.
GC.Collect()
can you run odoc.saveas after adding the document?
In Powerpoint, that assigns the filename-
Add the line of code
' Add a Document.
odoc = oWord.Documents.Add
odoc.Name = "DesiredNameHere"
to rename the word document.