I am trying to use VBA to create a label form in Word using data provided from Access. This VBA code works:
Dim appwd As Object
Dim oDoc As Object
Set appwd = CreateObject("Word.Application")
With appwd
.Documents.Add
Set oDoc = .MailingLabel.CreateNewDocumentByID(LabelID:="1359804671")
.Visible = True
.Activate
End With
oDoc.Activate
'Remaining code that creates labels
However, it creates and opens the blank Document1 as well as the Labels2 document I want. How do I prevent it from creating the unwanted Document1, or at the very least close that document again without saving it?
If I comment out the .Documents.Add, then I get
Run-time error '4605':
This method or property is not available because a document window is not active.
Unfortunately, the .MailingLabel object requires a document to be open, so the best alternative is to just close that document as soon as you create your desired one:
Dim appwd As Object
Dim oDoc As Object
Set appwd = CreateObject("Word.Application")
With appwd
.Documents.Add
Set oDoc = .MailingLabel.CreateNewDocumentByID(LabelID:="1359804671")
.Documents(1).Close SaveChanges:=0 'wdDoNotSaveChanges, close the first document
.Visible = True
.Activate
End With
oDoc.Activate
Related
I have a problem with the VBA code.
I would like to open this website: https://www.tnt.com/express/en_us/site/tracking.html and in Shipment numbers search box I would like to put active cells from Excel file. At the beginning I tried to put only a specific text for example: "777777".
I wrote the below code but unfortunately, the search button is empty and there is no error. I tried everything and I have no idea what should I change in my code.
Any clues? Thank you in advance.
HTML:
<input class="__c-form-field__text ng-touched ng-dirty ng-invalid" formcontrolname="query" pbconvertnewlinestocommasonpaste="" pbsearchhistorynavigation="" shamselectalltextonfocus="" type="search">
VBA:
Sub TNT2_tracker()
Dim objIE As InternetExplorer
Dim aEle As HTMLLinkElement
Dim y As Integer
Dim result As String
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "https://www.tnt.com/express/en_us/site/tracking.html"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Dim webpageelement As Object
For Each webpageelement In objIE.document.getElementsByClassName("input")
If webpageelement.Class = "__c-form-field__text ng-pristine ng-invalid ng-touched" Then
webpageelement.Value = "777"
End If
Next webpageelement
End Sub
You could use the querySelector + class name to find an element.
something like
'Find the input box
objIE.document.querySelector("input.__c-form-field__text").value = "test"
'Find the search button and do a click
objIE.document.querySelector("button.__c-btn").Click
No need to loop through elements. Unless the site allows you to search multiple tracking numbers at the same time.
It seems automating this page is a litte tricky. If you change the value of the input field it doesn' t work. Nothing happen by clicking the submit button.
A look in the dom inspector shows several events for the input field. I checked them out and it seems we need to paste the value over the clipboard by trigger the paste event of the shipping field.
In order for this to work without Internet Explorer prompting, its security settings for the Internet zone must be set to allow pasting from the clipboard. I'm using a German version of IE, so I have problems explaining how to find the setting.
This macro works for me:
Sub TNT2_tracker()
Dim browser As Object
Dim url As String
Dim nodeDivWithInputField As Object
Dim nodeInputShipmentNumber As Object
Dim textToClipboard As Object
'Dataobject by late binding to use the clipboard
Set textToClipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
url = "https://www.tnt.com/express/en_us/site/tracking.html"
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Manual break for loading the page complitly
'Application.Wait (Now + TimeSerial(pause_hours, pause_minutes, pause_seconds))
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get div element with input field for shipment number
Set nodeDivWithInputField = browser.Document.getElementsByClassName("pb-search-form-input-group")(0)
If Not nodeDivWithInputField Is Nothing Then
'If we got the div element ...
'First child element is the input field
Set nodeInputShipmentNumber = nodeDivWithInputField.FirstChild
'Put shipment number to clipboard
textToClipboard.setText "7777777"
textToClipboard.PutInClipboard
'Insert value by trigger paste event of the input field
Call TriggerEvent(browser.Document, nodeInputShipmentNumber, "paste")
'Click button
browser.Document.getElementsByClassName("__c-btn")(0).Click
Else
MsgBox "No input field for shipment number found."
End If
End Sub
And this function to trigger a html event:
Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)
Dim theEvent As Object
htmlElementWithEvent.Focus
Set theEvent = htmlDocument.createEvent("HTMLEvents")
theEvent.initEvent eventType, True, False
htmlElementWithEvent.dispatchEvent theEvent
End Sub
As #Stavros Jon alludes to..... there is a browserless way using xhr GET request via API. It returns json and thus you ideally need to use a json parser to handle the response.
I use jsonconverter.bas as the json parser to handle the response. Download raw code from here and add to standard module called JsonConverter . You then need to go VBE > Tools > References > Add reference to Microsoft Scripting Runtime. Remove the top Attribute line from the copied code.
Example request with dummy tracking number (deliberately passed as string):
Option Explicit
Public Sub TntTracking()
Dim json As Object, ws As Worksheet, trackingNumber As String
trackingNumber = "1234567" 'test input value. Currently this is not a valid input but is for demo.
Set ws = ThisWorkbook.Worksheets("Sheet1") 'for later use if writing something specific out
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.tnt.com/api/v3/shipment?con=" & trackingNumber & "&searchType=CON&locale=en_US&channel=OPENTRACK", False
.send
Set json = JsonConverter.ParseJson(.responseText)
End With
'do something with results
Debug.Print json("tracker.output")("notFound").Count > 0
Debug.Print JsonConverter.ConvertToJson(json("tracker.output")("notFound"))
End Sub
Quite new to VBA, having a problem with this error code.
run time error '91' object variable or With block variable not set
I'm trying to extract data from a website and past to a excel document. My Excel doc is Book2 and my module is called Module1. I'll paste the code below.
Sub WebNavigate()
Dim CreatingObject As Object
Dim WebNavigate As Object
Set objIE = CreatingObject("InternetExplorer.Application")
WebSite = "website link"
With objIE
.Visable = True
.navigate WebSite
Do While .Busy Or .readyState <> 4
DoEvents
Loop
Set elements = .document.getElementByClass("timark")
Sheet1.Cells(i, 8) = element.innerText
End With
End Sub
In the absence of HTML/URL to go with:
1) You are spelling of Visible is incorrect
2) The following:
Set elements = .document.getElementByClass("timark")
Is missing an s as it returns a collection and should be ClassName:
Set elements = .document.getElementsByClassName("timark")
3) You may need a pause or loop to ensure elements is available on the page.
4) This
Sheet1.Cells(i, 8) = element.innerText
You don't yet have element declared and assigned (you also don't have elements declared) . You may use in a For Loop.
e.g.
Dim element As Object, elements As Object
Set elements = .document.getElementsByClassName("timark")
For each element in elements
5) Creating should be Create (also as noted) and you need to declare objIE
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
6) i is not declared anywhere and must be greater than 1 when it is as there is no cell with row 0 in the sheet. Also, i would indicate a Loop of which there is no sign and when in a loop should be incremented to avoid overwriting the same cell.
7) Dim WebNavigate As Object is unassigned and not needed at present in the code.
8) To avoid many of the above use Option Explicit at the top of your code (As already mentioned).
I am coding an Access database that will collect user input, then open a Word document and fill out various parts of the document.
The problem I am having is it will only work once for Drop Down Lists. Not sure why or where to look to fix this one. There are three types of items I am programmatically filling in. The first is bookmarks, no problem with this. Second is Content Control Checkboxes, these also work with no problems. The third is Content Control Drop Down Lists, this is where the problem is. First time I open the Access Database it works, but if I click the command button again, nothing (for Drop Downs). The main problem is that it doesn't produce an error message, so I am not sure where to look.
I am guessing it has something to do with the objects I am creating to do the drop down updates? any help would be great:
Dim WordApp As Word.Application
Dim strTemplateLocation As String
Dim dir As String
Dim path As String
Dim wDoc As Word.Document
path = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
strTemplateLocation = path & "UserDoc.docx"
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, newtemplate:=False
With WordApp
'Working Bookmark
.Selection.GoTo what:=wdGoToBookmark, Name:="COMPANY": .Selection.TypeText [fac]
'Working checkbox
If Me.RD = True Then: .ActiveDocument.ContentControls(9).Checked = True
'Works ONCE drop down
Dim objCC As ContentControl
Dim objCE As ContentControlListEntry
Dim ListSelection As String
ListSelection = Me.System_Type.ListIndex + 2
Set objCC = ActiveDocument.ContentControls(1): Set objCE = objCC.DropdownListEntries.Item(ListSelection): objCE.Select
End With
Should I be closing out the objCE and objCC at the end or something?
This is probably your problem:
Set objCC = ActiveDocument.ContentControls(1)
It should be
Set objCC = .ActiveDocument.ContentControls(1)
But much better would be:
Set wDoc = WordApp.Documents.Add(Template:=strTemplateLocation, newtemplate:=False)
and then always use wDoc instead of WordApp.ActiveDocument.
See here: VBA ActiveDocument Concerns / Alternatives?
I am creating and opening a word document through access 2007 vba. The document is created but the focus is not shifted to word. Instead the focus still remains on access form through which am creating the doc. Below is my code:
Dim obj As Word.Application
Dim wor As Word.Document
Dim str As String
str = "C:\hello\folder1\vin.dot"
Set obj = CreateObject("Word.Application")
Set wor = obj.Documents.Add
With wor
.SaveAs str
.Close
End With
obj.Visible = True
obj.Documents.Open str
obj.WindowState = wdWindowStateMaximize
Any sugesstions please.
You can move the focus with AppActivate;
AppActivate "Microsoft Word"
The VBA Word.Application object may have more than one Window associated with it. You may specify which Window to display by using its Caption property.
Since you created a new Word.Application and only created one Document, you may assume that the 1st element (1-based array) is what you want to display in your code.
AppActivate (obj.Windows(1).Caption)
I was able to call the specific window even with other word documents open with the following:
Private Sub but_Click()
'must add tools > references Microsoft Word XX.X Object Library (xx.x is max update)
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
strProjPath = Application.CurrentProject.Path 'get current path
strVerWord = "test" 'i use this to identify paths that can change based on network configs.
posOp = InStr(1, strProjPath, strVerWord) ' find the verification word in the path
strVerPath = "strVerWord filepath\FP\FP\document.docx" 'create string location for document
strPathPlusDBName = Left(strProjPath, posOp - 1) & strVerPath
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(FileName:=strPathPlusDBName, ReadOnly:=True) 'open word file in read only
AppActivate WordDoc
End Sub
I am using Access to send data to a template I created in Word. After it succesfully sends the data I need to make the open Word Document NON-editable.
Also, I notice that after I am done with the Document it prompts to save. Is it possible to remove this prompt, BUT allow the capability to save.
This is the code I am using to do the Word Automation:
' Create a Word document from template.
Dim WordApp As Word.Application
Dim strTemplateLocation As String
Dim myVariable As String
myVariable = “TEST!!”
' Specify location of template
strTemplateLocation = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & "test.dot"
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
' Replace each bookmark with field contents.
WordApp.Selection.GoTo what:=wdGoToBookmark, Name:="myBookmark"
WordApp.Selection.TypeText myVariable
DoEvents
WordApp.Activate
Set WordApp = Nothing
The Document object has a Saved property which normally changes to False if any changes are made. If you set this property to True then you won't be prompted to save the document when you close it but you can still save it manually (via Save or Save As...) if you want to.
You can use the Protect method of the Document object to restrict the changes which the user can make. For example, you can call it with the parameter wdAllowOnlyReading which will mean that no changes of any kind can be made. You may also need to look at password protecting the document to prevent the user from simply unprotecting it again
This should do what you need. Tested from Excel, not Access, so you'll need to fix the template path
Sub Tester()
' Create a Word document from template.
Dim WordApp As Word.Application
Dim strTemplateLocation As String
Dim myVariable As String
myVariable = "TEST!!"
' Specify location of template
strTemplateLocation = ThisWorkbook.Path & "\test.dotx"
Set WordApp = CreateObject("Word.Application")
With WordApp
.Visible = True
.WindowState = wdWindowStateMaximize
.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
' Replace each bookmark with field contents.
.Selection.GoTo what:=wdGoToBookmark, Name:="myBookmark"
.Selection.TypeText myVariable
DoEvents
With .ActiveDocument
.Protect Type:=wdAllowOnlyReading, Password:="blah"
.Saved = True
End With
.Activate
End With
Set WordApp = Nothing
End Sub