The VBA code below was supplied to us, and should make it possible to return streetaddresses based on the postcode and housenumbers we have in excel.
But I can't seem to get it to work at all. Mind I am not a VBA expert :(
I have the key and know it's needed. I have a column with postcodes, and a column with streetnumbers. I need to output a streetname for each of those lines.
Any idea how to set this up?
Sub gkkx()
Dim xDoc As Object
Set xDoc = CreateObject("Microsoft.XMLDOM")
xDoc.async = False
If xDoc.Load("https://api.pro6pp.nl/v1/autocomplete?auth_key=KEYGOESHERE&format=xml&pretty=True&nl_sixpp=" & Postcode & "&streetnumber=" & Streetnumber) Then
If xDoc.DocumentElement.Text = "Not found" Then
Plaats = ""
Adres = ""
Else
If xDoc.DocumentElement.ChildNodes.Length = 0 Then
Dim xDoc2 As Object
Set xDoc2 = CreateObject("Microsoft.XMLDOM")
xDoc2.async = False
xDoc2.Load ("https://api.pro6pp.nl/v1/autocomplete?auth_key=KEYGOESHERE&format=xml&pretty=True&nl_sixpp=" & Left(Postcode, 4))
Plaats = xDoc2.DocumentElement.SelectSingleNode("result/city").Text
Adres = ""
Set xDoc2 = Nothing
Else
Plaats = xDoc.DocumentElement.SelectSingleNode("results/result/city").Text
Adres = xDoc.DocumentElement.SelectSingleNode("results/result/street").Text
End If
'If xDoc.documentElement.childNodes.length > 1 Then
' Tekst41 = MsgBox("Meerdere straten op deze Postcode", vbInformation, "Meerdere Straten")
'End If
End If
Else
' The document failed to load.
Plaats = ""
Adres = ""
End If
Set xDoc = Nothing
End Sub
I'm just glancing through your code and not doing any testing or really analyzing what it is supposed to do. There are some code lines commented-out at the bottom section:
'If xDoc.documentElement.childNodes.length > 1 Then
' Tekst41 = MsgBox("Meerdere straten op deze Postcode", vbInformation, "Meerdere Straten")
'End If
You may want to ask the code author if they intended this section of code to be left in as a comment - commenting-out code means the lines of code are ignored by the compiler. Comments are created by prefixing any text with the apostrophe character. Many times, when someone is writing code, they will comment out parts of the code so they can test individual sections of the code. It could be that the author was doing this and forgot to un-comment (by deleting the apostrophes) this section of code.
Also, I would point out that this code appears to be working with Microsoft.XMLDOM. To get a start on understanding what this code is doing, you may want to have a look HERE.
It's probably not a total answer but I hope it helps. It is a bit difficult, based on the brevity and vagueness of your question, to really have a picture of what you are trying to ask.
Related
Morning all! I am stuck and would appreciate any help I can get.
Part of my subroutine gets a value from a recordset. If the query that the recordset is based on doesn't return a value then I get the error:
'3021' No Current Record
I'm trying to check for null records and redirect my vba code elsewhere to avoid this error but I'm unable to do so. All references I have seen so far have said to do this same thing, which is what I tried
IsNull(rst.FIelds("field").Value)
and still doesn't work. I'm not sure where to do from here.
Code is below.
At the moment for debugging purposes I have hardcoded values 27 and Schematic but please note that in the real subroutine these will be variables.
All your help is much appreciated! Have a great day :)
Dim dbs As DAO.Database
Dim rst_Trim As DAO.Recordset
Set dbs = CurrentDb
qrystring = "SELECT tblDocuments.Trim FROM tblDocuments WHERE (tblDocuments.ID = 27 AND tblDocuments.type = 'Schematic')"
Set rst_Trim = dbs.OpenRecordset(qrystring, dbOpenSnapshot)
If IsNull(rst_Trim.Fields("trim").Value) Then
'do stuff
MsgBox "null"
Else
trimNumber = rst_Trim.Fields("trim").Value
'do stuff
MsgBox trimNumber
End If
As you expect only one or "a" value, DLookup can do it:
Dim TrimValue As Variant
TrimValue = DLookup("[Trim]", "[tblDocuments]", "[ID] = 27 And [Type] = 'Schematic'")
If IsNull(TrimValue) Then
' Do stuff.
MsgBox "null"
Else
trimNumber = TrimValue
' Do stuff.
MsgBox trimNumber
End If
Does not like use of .Value property when recordset is empty. Value is default property and not necessary to reference. Just remove it from your code and it should work.
Otherwise, another way to test if recordset has records:
If rs.EOF Then
MsgBox "No records"
Else
'do something
End If
I hope my first post will be OK and not offend (I've tried to follow the guide and done a lot of searching).
I've modified the below code from Greg Maxey (https://gregmaxey.com/word_tip_pages/word_fields.html) to update links in my Word document to an Excel workbook. It seems to be the most used code for this purpose. The reason I changed his code was to try to do away with the need to have a counter variable like i, and using a For i = 1 to .Fields.Count Then... Next i structure.
When I run it as is, it gets stuck in a loop only updating the first field in the Word document. To see this, I put in the Debug.Print wrdField.Index line. It repeatedly outputs 1, so it is not moving to the Next wrdField as I expect (the code actually just used Next, but it's the same result if I use Next wrdField).
When I comment out .AutoUpdate = False, it works properly:
Public Sub UpdateExternalLinksToCurrentFolder()
Dim wrdDocument As Word.Document
Dim wrdField As Word.Field
Dim strCurrentLinkedWorkbookPath, strNewLinkedWorkbookPath As String
Dim strCurrentLinkedWorkbookName, strNewLinkedWorkbookName As String
Dim strCurrentLinkedWorkbookFullName, strNewLinkedWorkbookFullName As String
Dim strThisDocumentPath As String
'On Error GoTo ErrorHandler_UpdateExternalLinksToCurrentFolder
Application.ScreenUpdating = False
Set wrdDocument = ActiveDocument
strThisDocumentPath = wrdDocument.Path & Application.PathSeparator
strNewLinkedWorkbookPath = strThisDocumentPath
With wrdDocument
For Each wrdField In .Fields
With wrdField
If .Type = wdFieldLink Then
With .LinkFormat
Debug.Print wrdField.Index
strCurrentLinkedWorkbookPath = .SourcePath & Application.PathSeparator
strCurrentLinkedWorkbookName = .SourceName
strNewLinkedWorkbookName = strCurrentLinkedWorkbookName
strNewLinkedWorkbookFullName = strNewLinkedWorkbookPath & strNewLinkedWorkbookName
.AutoUpdate = False
End With
.Code.Text = VBA.Replace(.Code.Text, Replace(strCurrentLinkedWorkbookPath, "\", "\\"), Replace(strNewLinkedWorkbookPath, "\", "\\"))
End If
End With
Next
End With
Set wrdDocument = Nothing
Application.ScreenUpdating = True
Exit Sub
Can anyone tell my why it's behaving this way? When I set .AutoUpdate = False, am I changing something about the link field or doing something to the Word document that causes the .wrdField.Index to reset to 1? I can't find anything online documenting this behavior and it's driving me nuts.
Behind the scenes, what's happening is that Word recreates the content and the field. The orginal linked content is removed and new content inserted. So that essentially destroys the field and recreates it. A user won't notice this, but VBA does.
When dealing with a loop situation that uses an index and the looped items are being removed, it's therefore customary to loop backwards (from the end of the document to the beginning). Which cannot be done with For...Each.
I've been fighting with this for a while and I'm not getting why the if statement is returning true when one of the AND statements is obviously false.
strtmp = TypeName(ctl) 'Take for instance (and have verified) this returns String type with the value of Label. However the below is returning true in this case.
If (strtmp = "TextBox") And (arControlName(2) = "Desc") And Trim(Me.Controls(ctl.Name).Value & "") = "" Then
'Do some stuff
End If
My problem is the first statement of the if is somehow equating to true OR "And" is not working as I expect "The AND = TRUE if all conditions are TRUE. The AND=FALSE if any of the conditions are FALSE." OR I'm using it wrong?
Perhaps I am simply loosing my marbles as well :)
EDIT: If the statements are broken out into 3 separate If statements (like below), the code works as expected.
If (strtmp = "TextBox") Then
If (arControlName(2) = "Desc") Then
If Trim(Me.Controls(ctl.Name).Value & "") = "" Then
' Set the value and exit loop
End If
End If
End If
Thanks to the help of the comments that got my brain jogging in a different direction, I've determined the problem.
It apparently has something to do with VBA and not liking to execute certain calls in an If Statement It seems to work fine putting the TypeName(ctl) = "TextBox" in the if statement but not the call to Me.Controls(ctl.Name).Value & "".
strctlTypeName = TypeName(ctl)
strctlVal = Trim(Me.Controls(ctl.Name).Value & "")
If ((strctlTypeName = "TextBox") And (arControlName(2) = "Desc")) And strctlVal = "" Then 'And (Trim(Me.Controls(ctl.Name).Value & "") = "") Then
'Set the value and exit inner for loop
End If
I've come here for plenty of advice on how to develop VBScript and VBA applications using Excel, but now I've been faced with a new challenge: develop a VBScript/VBA application for Word.
I know, in Excel, if I wanted to type "my name" in cell B3, I would type this:
Range("B3").Value = "my name"
I need to be able to locate where a name and address for a formal letter would be entered, as well as today's date, and my initials as a signature.
I thought I might be able to find VBScript/VBA programming for Word on the internet like I did for Excel, but it seems like working with Word is not as popular. If anyone has any snippets to get me started, or a really good link to a site on the internet where I can do the coding myself, it would be greatly appreciated.
UPDATE
Here is the code I'm working with at the moment:
Public Sub WordVbaDemo()
Dim doc As Document: Set doc = ActiveDocument ' Or any other document
DateText = doc.Range(doc.Paragraphs(1).Range.End - 20, doc.Paragraphs(1).Range.End - 18).Text
End Sub`
I need the code to work for a formal letter where the date is right-justified:
Date: November 7th, 2016
The code I have above will copy the date text after "Date: ". The original template doesn't have a prefilled date. If I enter one, the "Member: " field looks offset like this:
Date: November 7th, 2016
Member:
I'm looking for a way to enter text without upsetting the alignment.
UPDATE 2
I forgot to mention this has to work as an external script. This means, if I were to open NotePad and create a script that would fill out a letter in a Word document, that is how it should work. I do apologize for this...got ahead of myself and forgot that detail.
UPDATE 3
I'm using the following code derived from code I use to find any open Internet Explorer windows. I know IE and Word are two different things, but I was hoping I could use Shell to find the Word doc and be able to manipulate the content.
Dim WinDoc, Window, TitleFound
Dim WShell, objShell
Function Check_Document()
On Error Resume Next
Set WShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
On Error GoTo 0
Window = "non-member template.docx" 'Tried this without the .docx and failed
TitleFound = False
For Each WinDoc In objShell.Windows()
If Err.Number = 0 Then
If InStr(WinDoc.Document.Title, (Window)) Then
Set objWord = WinDoc
TitleFound = True
Exit For
End If
End If
Next
If TitleFound = False Then
MsgBox "Word doc not found"
Else
MsgBox "Found Word doc!!"
End If
End Function
I was in a similar boat about 6 months ago. I had done VBA in Excel, but was asked to do some more in Word. The thing about Word VBA is that there are far fewer reasons to need to automate a Word document than an Excel document. From what I've gathered, most situations involve creating legal documents.
I've come a long way and I do have a number of sites bookmarked that I'll dig further into for you.. but this one is a quickstart to using VBA in Word.
http://word.mvps.org/faqs/MacrosVBA/VBABasicsIn15Mins.htm
But one pointer: consider if the document layout is going to be structured or not.(It wasn't clear to me in your question). If the layout is going to be structured, where you know exactly where everything is going, you might want to use bookmarks. Otherwise, you may consider the paragraphs method as indicated by z32a7ul.
My project uses UserForms as input. It's been a real challenge at times, but by using Userforms with Bookmarks, I'm able to allow the user to navigate back and forth in the userForms as well as re-run the macro (assuming they have not deleted required bookmarks).
Of course, take this with a grain of salt since I'm still learning as well. For what it's worth, I've also had the added challenge of making this all work on the Mac platform.
As a starting point:
Public Sub WordVbaDemo()
Dim doc As Document: Set doc = ActiveDocument ' Or any other document
' doc.Paragraphs(2).Range.Text = "Error if the document is empty (there is no second paragraph)."
doc.Paragraphs(1).Range.Text = "First paragraph overwritten." & vbCrLf
doc.Paragraphs(2).Range.Text = "Now I can write to Paragraph 2." & vbCrLf
doc.Paragraphs.Add(doc.Paragraphs(2).Range).Range.Text = "Inserted between Paragraph 1 and 2." & vbCrLf
doc.Range(doc.Paragraphs(3).Range.End - 3, doc.Paragraphs(3).Range.End - 2).Font.StrikeThrough = True
doc.Range(doc.Paragraphs(3).Range.End - 2, doc.Paragraphs(3).Range.End - 2).Text = 3
doc.Range(doc.Paragraphs(3).Range.End - 3, doc.Paragraphs(3).Range.End - 2).Font.StrikeThrough = False
With doc.Tables.Add(doc.Range(doc.Range.End - 1), 2, 2)
.Cell(1, 1).Range.Text = "Header1"
.Cell(1, 2).Range.Text = "Header2"
.Cell(2, 1).Range.Text = "Value1"
.Cell(2, 2).Range.Text = "Value2"
Dim varBorder As Variant: For Each varBorder In Array(wdBorderTop, wdBorderBottom, wdBorderLeft, wdBorderRight, wdBorderVertical, wdBorderHorizontal)
.Borders(varBorder).LineStyle = wdLineStyleSingle
Next varBorder
.Rows(1).Shading.BackgroundPatternColor = RGB(123, 45, 67)
.Rows(1).Range.Font.Color = wdColorLime
End With
End Sub
First of all, I want to thank everyone who replied. You helped guide me to my solution. Below is the code I came up with to locate where a name and address for a formal letter would be entered, as well as today's date, and my initials as a signature.
Function Check_Document()
On Error Resume Next
Set objWord = CreateObject("Word.Application")
On Error GoTo 0
objWord.Visible = True
Set objDoc = objWord.Documents.Open("C:\Users\lpeder6\Desktop\myDoc.docx")
Set objRange = objDoc.Bookmarks("TodaysDate").Range
objRange.Text = "November 11th, 2016"
Set objRange = objDoc.Bookmarks("Name").Range
objRange.Text = "John Smith"
Set objRange = objDoc.Bookmarks("Address").Range
objRange.Text = "123 N. Anywhere Ave."
Set objRange = objDoc.Bookmarks("City").Range
objRange.Text = "Northwoods" & ", "
Set objRange = objDoc.Bookmarks("State").Range
objRange.Text = "MN"
Set objRange = objDoc.Bookmarks("Zip").Range
objRange.Text = "55555"
Set objRange = objDoc.Bookmarks("Init").Range
objRange.Text = "JS"
End Function
The bookmarks are preset within the document so the code has something to look for. Anything within these fields gets replace with the objRange.Text. Variables could be used to store information if this was external coding and the variables would contain data from arguments sending the data.
I hope this code helps others as much as it helped me. Thanks again to everyone who offered me ideas that got me here.
Disclaimer: It's been a few years since I worked (a lot) with VBA, so this might be an issue caused by confusing myself with what is essentially a very different language from what I usually deal with.
So; I've got a workbook (Excel 2010) with multiple sheets (20+), most of whom are multi-page. To make things easier when printing everything, I want to add some sheet-specific headers with amongst others the name of the sheet, number of pages and so on.
I've written a tiny function that should (in theory) do this for me by iterating over all the sheets setting the header. However, for some reason it only works if the header is empty; if it already has a value it refuses to overwrite for some unknown reason.
Dim sheetIndex, numsheets As Integer
sheetIndex = 1
numsheets = Sheets.Count
' Loop through each sheet, but don't set any of them to active
While sheetIndex <= numsheets
Dim sheetname, role, labeltext As String
sheetname = Sheets(sheetIndex).name
role = GetRole(mode)
labeltext = "Some text - " & sheetname & " - " & role
With Sheets(sheetIndex).PageSetup
.LeftHeader = labeltext
.CenterHeader = ""
.RightHeader = "Page &[Page] / &[Pages]"
.LeftFooter = "&[Date] - &[Time]"
.CenterFooter = ""
.RightFooter = "Page &P / &N"
End With
sheetIndex = sheetIndex + 1
Wend
I found a solution that seems to work for replacing text. For whatever reason, in the macro, you need to include the header/footer format character codes in order for it to work properly.
This code worked to replace existing header text with new information:
Sub test()
Dim sht As Worksheet
Set sht = Worksheets(1)
sht.PageSetup.LeftHeader = "&L left text"
sht.PageSetup.CenterHeader = "&C center Text"
sht.PageSetup.RightHeader = "&R right text"
End Sub
Without the &L, &C, and &R codes before the text, I could not get it to work.
Some interesting behavior I found is that if you use the following code:
.CenterHeader = "&L some text"
it will actually put the some text in the LeftHeader position. This led me to believe that the formatting codes were very important.
The line Application.PrintCommunication = False (which is added by the macro recorder) before doing PageSetup screws up the formating via VBA.
If your code has got this line in it, try removing it. That solved my problem with setting the header and footer via VBA.
I've read StackOverflow for years and this is the first time I've actually been able to post a solution ... hope it helps someone!! Also, you need to remember, I am a CPA not a programmer ;-)
I am reading some values from the ActiveSheet to populate the header. The application is a tax election that will be sent with a tax return so it must have the taxpayer's name and social security number at the top.
Sub PrintElection()
' Print preview the MTM Election
If Range("Tax_Year").Value = Range("First_MTM_year").Value Then
ActiveSheet.PageSetup.LeftHeader = Format(Worksheets("Election").Range("Taxpayer_Name").Value)
ActiveSheet.PageSetup.RightHeader = Format(Worksheets("Election").Range("Taxpayer_SSN").Value)
ActiveWindow.SelectedSheets.PrintPreview
Else
MsgBox "The 'Effective For Tax Year' date must EQUAL the 'First MTM year' date", vbOKOnly, "Check Years"
Sheets("Roadmap").Select
Range("First_MTM_year").Select
End If
End Sub
It checks to see if the Mark-to-Market election year is the same as the election form then formats the election page.
I split the sheet print setup into 2 loops. First loop with Application.PrintCommunication = False I run the non-header/footer setup. I then set Application.PrintCommunication = True and run the header/footer setup in a second loop. Appears to run faster than in XL2003, and applies the header/footer correctly. Until MS fixes this bug, that works fine for me.