I am using Microsoft MapPoint 18.0 object library as a reference in VB 6.0 . After creating an object and passing the address parameters , the program doesnt return any latitude,longitude data for any valid address. was wondering if this is a dll issue for VB 6.0 ?
I just did a quick test using the reference "Microsoft MapPoint 19.0 Object Library (North America)" and the following code worked for me:
Private Sub Command1_Click()
Dim mmpApp As MapPoint.Application, mmpMap As MapPoint.Map, _
mmpFindResults As MapPoint.FindResults
Set mmpApp = New MapPoint.Application
Set mmpMap = mmpApp.ActiveMap
Set mmpFindResults = mmpMap.FindAddressResults( _
"24 Sussex Drive", _
"Ottawa", _
"", _
"ON", _
"", _
MapPoint.GeoCountry.geoCountryCanada)
If mmpFindResults.ResultsQuality = geoFirstResultGood Then
MsgBox "First result returned: (" & mmpFindResults(1).Latitude & "," & _
mmpFindResults(1).Longitude & ")"
Else
MsgBox "The search returned poor, ambiguous, or non-existent results"
End If
Set mmpFindResults = Nothing
Set mmpMap = Nothing
Set mmpApp = Nothing
End Sub
I expect that it would also work under the 18.0 version.
Related
MS Word 2010 has a bug in its ability to correctly maintain (of all things) the documents collection (link to earliest report found - social.msdn.microsoft.com).
As far as I can tell this bug only impacts Word 2010. Although the documents collection is not maintained, it turns out that the Application.Windows collection is. Hence, for Word 2010 the following code based on the original reporters investigation (see below) and this question on answers.microsoft.com seem to provide a good alternative to the buggy documents collection:
' PURPOSE:
' Return a document collection, work-around for Word 2010 bug
Public Function docCollection() As VBA.Collection
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Can NOT use 'name' - fails to be unique
End If
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
End Function
However, and here's my question, the above code some times fails with error 457 This key is already associated with an element of this collection on line resultDoc.Add foundDoc, foundDoc.FullName. What circumstances could possibly lead to such a failure?
So far the code has only failed on 1 PC running Word 2016. I don't have access to the PC. I did discover that the original version used Document.Name as the key (which was not always unique, so this was changed to Document.Full name)
Assumptions:
Document.FullName will always be unique
Things I've ruled out:
use of Split Window
opening downloaded documents (protected window documents are not counted)
Code that can be used to demonstrate the issue in Word 2010 (adapted from the original report).
' Function Credit Bas258 (https://social.msdn.microsoft.com/profile/bas258)
Function test01() As Boolean
'Adapted to VBA from original: 03-11-2012 1.0 Visual Studio 2008 VB code
Dim oDoc As Word.Document
Dim oDoc0 As Word.Document
Dim oDoc1 As Word.Document
Dim oDoc2 As Word.Document
Dim oDoc3 As Word.Document
Dim oDoc4 As Word.Document
Dim n As Integer
Set WDapp = Application
With WDapp
Debug.Print (Format(Now(), "dd-MM-yyyy") & " MS Office " & .Application.Version)
Set oDoc0 = .Documents.Add: Debug.Print ("add " & oDoc0.Name)
Set oDoc1 = .Documents.Add: Debug.Print ("add " & oDoc1.Name)
Set oDoc2 = .Documents.Add: Debug.Print ("add " & oDoc2.Name)
Set oDoc3 = .Documents.Add: Debug.Print ("add " & oDoc3.Name)
Set oDoc4 = .Documents.Add: Debug.Print ("add " & oDoc4.Name)
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
Debug.Print ("close " & oDoc4.Name)
oDoc4.Close
Set oDoc4 = Nothing
Debug.Print ("close " & oDoc3.Name)
oDoc3.Close
Set oDoc3 = Nothing
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
n = 0
For Each oDoc In .Documents
n = n + 1
Debug.Print ("doc " & n & " " & oDoc.Name)
Next oDoc
n = 0
For Each oWin In .Windows
n = n + 1
Debug.Print ("win " & n & " " & oWin.Document.Name)
Next oWin
Debug.Print ("close " & oDoc2.Name)
oDoc2.Close
Set oDoc2 = Nothing
Debug.Print ("close " & oDoc1.Name)
oDoc1.Close
Set oDoc1 = Nothing
Debug.Print ("close " & oDoc0.Name)
oDoc0.Close
Set oDoc0 = Nothing
End With
Set WDapp = Nothing
End Function
This is NOT going to be the accepted answer. Although it does answer the broader question (what could cause this code to crash) it not address the specific crash that I am trying to isolate. Either way there appears to be another bug in MS Word which seemed to be worth capturing for the common good.
This time the bug is with the Windows Collection; and joy of joys, I've confirmed it for both Word 2010 and Word 2016 - both 64 bit apps.
Steps to reproduce the bug are as follows:
In windows explorer enable the Preview Pane
Select a word document FILE so that it is 'previewed'
Open the same document (without losing the 'preview view')
Run the code from the OP, it will crash on this line:
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
It turns out that when a word file is being previewed the Application.Windows.Count property is incremented by the preview; however any attempt to get a property of that window results in Error 5097 - Word has encountered a problem.
So, an improvement to the original code would therefore be:
' PURPOSE:
' Returns a healthy document collection
' - work-around for Word 2010 bug
' - excludes hits from Windows Explorer Preview Pane
Public Function docCollection() As VBA.Collection
On Error GoTo docCollectionError
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
' Use index instead of Each to avoid For Loop Not initialised error, preview pane
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Key must NOT be 'name' - fails to be unique see BUG: 1315
End If
lblSkipThisDoc:
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
Exit:
Exit Function
docCollectionError:
If Err.Number = 5097 Then ' An open document is also open in the Windows Explorer Preview Pane
Err.Clear
Resume lblSkipThisDoc ' - skip this window
End If
If Err.Number = 457 Then ' Key is already used, but HOW? Unknown cause of error
Err.Clear
Stop 'Resume lblSkipThisDoc ' Is it safe to skip this document, why is there a duplicate?
End If
End Function
There is a setting in MS Word that enables 1 document to be viewed in 2 windows. In Word 2010 it is under the View (Tab): Window > New Window
The new window is counted separately in Application.Windows.Count and returns the same document object, hence the key exists.
For indexOfAvailableAppWindows = 1 To Application.Windows.Count ' <<< New Windows is counted
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' <<< fails to add 2nd instance of document
End If
So... the solution would likely involve checking the caption of the document:
IMMEDIATE WINDOW:
?foundDoc.Windows(1).Caption
Document2:1
I have created a VBA Application in MS Excel 2010. It has one user form. There I'd like to add a feature to open a (MS Word) file for support and FAQ purposes. I do not want to save the file at a central location and open the file then via VBA. Is there a possibility to store the file maybe inside the vba project?
You can embed an object in an Excel Worskeet (Insert -> Object). If you click on the embedded object, in the upper left corner you will see the name of the object (e.g. "Object 7"). With that you can open it in vba via
Sub openEmbed()
Dim ole As OLEObject, wdoc As Word.Document
Set ole = Worksheets("Sheet1").OLEObjects("Object 7")
ole.Activate
Set wdoc = ole.Object
End Sub
You could store the content as XML in the VBA and then insert it with InsertXML in a new document:
Dim app As Object
Set app = CreateObject("Word.Application")
app.Visible = True
app.Documents.Add.Content.InsertXML "<?xml version=""1.0""?><abc:books xmlns:abc=""urn:books"" " & _
"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" " & _
"xsi:schemaLocation=""urn:books books.xsd""><book>" & _
"<author>Matt Hink</author><title>Migration Paths of the Red " & _
"Breasted Robin</title><genre>non-fiction</genre>" & _
"<price>29.95</price><pub_date>2006-05-01</pub_date>" & _
"<abstract>You see them in the spring outside your windows. " & _
"You hear their lovely songs wafting in the warm spring air. " & _
"Now follow their path as they migrate to warmer climes in the fall, " & _
"and then back to your back yard in the spring.</abstract></book></abc:books>"
The major and minor version of an office application can be found using Application.Version.
Return examples:
15.0 = Office 2013
12.0 = Office 2007
I require the revision and build version of the office application, example:
Microsoft Office PowerPoint 2007 Original: major.minor: 12.0 revision.build: 4518.1014
Microsoft Office PowerPoint 2007 SP2: major.minor: 12.0 revision.build: 6425.1000
Question: Is there a way of finding the revision and build version of an office application, using VBA?
Question updated: Naming convention mistake on my side - Looking for the revision and build version of an office application, not the minor version.
VBA does not have a function to do it directly, you will have to write a function to do it:
Public Sub test()
Dim version As String
Dim chkref As Object
' List of references
For Each chkref In ThisWorkbook.VBProject.References
version = RetrieveDllVersion(chkref.fullpath)
major = RetrievePart(version, 0)
majorup = RetrievePart(version, 1)
minor = RetrievePart(version, 2)
minorup = RetrievePart(version, 3)
MsgBox chkref.Name & " : " & major & "." & majorup & "." & minor & "." & minorup
Next
End Sub
Private Function RetrieveDllVersion(ByVal dll As String) As String
Dim fso As Object 'Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
RetrieveDllVersion = fso.GetFileVersion(dll)
End Function
Private Function RetrievePart(ByVal version As String, ByVal pos As Integer) As String
RetrievePart = Split(version, ".")(pos)
End Function
Filter Excel / Office / Word on the chkref.name
Summary of alternatives :
Application.Version "16.0"
Application.Build "16.0.8431"
Application.BuildFull "16.0.8431.0"
CreateObject("Scripting.FileSystemObject") _
.GetFileVersion(Application.Path & "\WINWORD.exe") "16.0.8431.2280"
I have project that require I maintain log of users (using Application.UserName) that perform a certain actions with a macro-enabled Excel spreadsheet. I've tried using the VB examples found at the links list below and modifying for VBA, but I'm running into error at last line of Sub. Can anyone point me towards a better VBA example or guide me in the right direction?
http://msdn.microsoft.com/en-us/library/bb608627.aspx
http://msdn.microsoft.com/en-us/library/bb608612.aspx
Here's the code I'm currently working with.
Private Sub AddCustomXmlPartToWorkbook(ByVal Workbook As Excel.Workbook)
Dim xmlString As String
xmlString = _
"<?xml version=""1.0"" encoding=""utf-8"" ?>" & _
"<employees xmlns=""http://schemas.microsoft.com/vsto/samples"">" & _
"<employee>" & _
"<name>Karina Leal</name>" & _
"<hireDate>1999-04-01</hireDate>" & _
"<title>Manager</title>" & _
"</employee>" & _
"</employees>"
Dim employeeXMLPart As Office.CustomXMLPart
employeeXMLPart = ActiveWorkbook.CustomXMLParts.Add(xmlString)
End Sub
You just run the statement that adds the CustomXMLPart:
Call ActiveWorkbook.CustomXMLParts.Add(xmlString)
It is added to the end of the collection, so you know it's position by doing ActiveWorkbook.CustomXMLParts.Count
Is it possible to change the Startup Display Form using VBA? It is very easy to do using the Access Options page, but I am trying to do this from within VBA and nothing seems to work. I've searched all over looking for Database properties or settings that would allow for this.
Does anyone have any insight into this issue?
I don't know about directly changing the startup form property but what you could try is creating a form that can load your desired startup form. This way you can for instance store the form to be loaded in a config table and change it via VBA.
Downside is that effectively two forms are started and not one.
Have a look at the autoexec macro. It'll run code for you when your database is launched. Use this to load a form.
You can set a form to automatically open up in access VBA by setting the built-in database property StartUpForm to the name of the form.
To remove this form from startup you can simply delete that property.
Private Sub debug_properties()
ListProperties
SetProperty "StartupForm", 10, "Form_Name" 'UPDATE TO YOUR FORM NAME
' DeleteProperty "StartupForm"
' ListProperties
End Sub
Public Function SetProperty(ByVal propName As String, ByVal propType As Long, propValue As Variant)
''SetProperty will create a property if it doesn't exist
On Error GoTo SetProperty_Err
Dim dbs As DAO.Database ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set dbs = CurrentDb
Dim prps As DAO.Properties ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set prps = dbs.Properties
''attempt to set property
prps(propName) = propValue
SetProperty_Exit:
On Error Resume Next
On Error GoTo 0
Exit Function
SetProperty_Err:
Select Case Err.Number
Case 3270 ''The property was not found
''create property
Dim prp As DAO.Property
Set prp = dbs.CreateProperty(Name:=propName, _
Type:=propType, _
Value:=propValue)
''add new property to collection
dbs.Properties.Append prp
Case Else
MsgBox "SetProperty, Error " & Err.Number & ": " & Err.Description
End Select
Resume SetProperty_Exit
End Function
Private Function DeleteProperty(ByVal propName As String)
On Error GoTo DeleteProperty_Err
Dim dbs As DAO.Database ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set dbs = CurrentDb
dbs.Properties.Delete propName
DeleteProperty_Exit:
On Error Resume Next
On Error GoTo 0
Exit Function
DeleteProperty_Err:
Select Case Err.Number
Case 3265 ''The property was not found
MsgBox "Property '" & propName & "' does not exist."
Case Else
MsgBox "DeleteProperty, Error " & Err.Number & ": " & Err.Description
End Select
Resume DeleteProperty_Exit
End Function
Private Sub ListProperties()
''Lists DB properties created in code (as well as built-in properties)
Dim dbs As DAO.Database ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set dbs = Application.CurrentDb
Debug.Print vbCrLf & Format(Now, "hh:mm:ss") & " ======="
Debug.Print """" & Mid(CurrentDb.Name, _
InStrRev(CurrentDb.Name, "\") + 1, _
InStr(CurrentDb.Name, ".accdb") - InStrRev(CurrentDb.Name, "\") - 1) & _
""" Properties: "
On Error Resume Next 'skips the 'connection' property which has no 'value' for some reason
Dim prp As DAO.Property
For Each prp In dbs.Properties
Debug.Print prp.Name & ": " & prp.Value
Next prp
On Error GoTo 0
End Sub