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.
Related
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 have some code which works great if putting the values into an Excel sheet but when I have tried to make it write to a text file it just writes the following over and over again:
objAddressEntry.Name
objAddressEntry.Name
Code below. I've left in the bit that originally wrote to Excel but it's commented out.
Sub GetOutlookAddressBook()
' Need to add reference to Outlook
'(In VBA editor Tools References MS Outlook #.# Library)
' Adds addresses to existing Sheet called Address and
' defines name Addresses containing this list
' For use with data Validation ListBox (Source as =Addresses)
On Error GoTo error
Dim objOutlook As Outlook.Application
Dim objAddressList As Outlook.AddressList
Dim objAddressEntry As Outlook.AddressEntry
Dim intCounter As Integer
Application.ScreenUpdating = False
' Setup connection to Outlook application
Set objOutlook = CreateObject("Outlook.Application")
Set objAddressList = objOutlook.Session.AddressLists("Global Address List")
Application.EnableEvents = False
' Clear existing list
' Sheets("Address").Range("A:A").Clear
' Create text file
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile("C:\Users\username\Desktop\test.txt")
'Step through each contact and list each that has an email address
For Each objAddressEntry In objAddressList.AddressEntries
If objAddressEntry.Address <> "" Then
intCounter = intCounter + 1
Application.StatusBar = "Address no. " & intCounter & " ... " & objAddressEntry.Address
' Write to text file
oFile.WriteLine "objAddressEntry.Name" & vbNewLine
' Sheets("Address").Cells(intCounter, 1) = objAddressEntry.Name
DoEvents
End If
Next objAddressEntry
' Close the text file
oFile.Close
Set fso = Nothing
Set oFile = Nothing
' Define range called "Addresses" to the list of emails
' Sheets("Address").Cells(1, 1).Resize(intCounter, 1).Name = "Addresses"
error:
Set objOutlook = Nothing
Application.StatusBar = False
Application.EnableEvents = False
End Sub
Note that I rarely use VBA so I apologise if this is a trivial issue. I have struggled to find anything relevant in previous questions/answers as the search terms are quite broad.
My question is: How do I make it write the actual value rather than the name of the object?
If you just want to write the .Name then,
oFile.WriteLine objAddressEntry.Name & vbNewLine
... but if you want to write the .Name in quotes then,
oFile.WriteLine chr(34) & objAddressEntry.Name & chr(34) & vbNewLine
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
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!
I try to call a VBA subroutine from VBS with passing a string variable from VBS to VBA, but can't find the appropiate syntax:
'VBS:
'------------------------
Option Explicit
Set ArgObj = WScript.Arguments
Dim strPath
mystr = ArgObj(0) '?
'Creating shell object
Set WshShell = CreateObject("WScript.Shell")
'Creating File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Getting the Folder Object
Set ObjFolder = objFSO.GetFolder(WshShell.CurrentDirectory)
'Getting the list of Files
Set ObjFiles = ObjFolder.Files
'Creat a Word application object
Set wdApp = CreateObject("Word.Application")
wdApp.DisplayAlerts = True
wdApp.Visible = True
'Running macro on each wdS-File
Counter = 0
For Each objFile in objFiles
If UCase(objFSO.GetExtensionName(objFile.name)) = "DOC" Then
set wdDoc = wdApp.Documents.Open(ObjFolder & "\" & ObjFile.Name, 0, False)
wdApp.Run "'C:\Dokumente und Einstellungen\kcichini\Anwendungsdaten\Microsoft\Word\STARTUP\MyVBA.dot'!Test_VBA_with_VBS_Args" (mystr) 'how to pass Argument???
Counter = Counter + 1
End if
Next
MsgBox "Macro was applied to " & Counter & " wd-Files from current directory!"
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
'------------------------
'VBA:
'------------------------
Sub Test_VBA_with_VBS_Args()
Dim wdDoc As Word.Document
Set wdDoc = ActiveDocument
Dim filename As String
Dim mystr As String
'mystr = how to recognize VBS-Argument ???
filename = ActiveDocument.name
MsgBox "..The file: " & filename & " was opened and the VBS-Argument: " & mystr & "recognized!"
wdDoc.Close
End Sub
'------------------------
You need to specify parameters in your VBA Sub and use them as you would do if using it from VBA normally.
For example, I tried the following VBScript
dim wd: set wd = GetObject(,"Word.Application")
wd.Visible = true
wd.run "test", "an argument"
and the VBA
Sub Test(t As String)
MsgBox t
End Sub
which worked successfully, generating a message box.
Addendum to #user69820 answer, if arguments are VBScript variables, they need to be cast as appropriate type before calling the subroutine:
This does not work:
dim argumentVariable
argumentVariable = "an argument"
wd.run "test", argumentVariable
This does:
dim argumentVariable
argumentVariable = "an argument"
wd.run "test", CStr(argumentVariable)
Tested on Excel 2010, Win7SP1 x64