GIS Web Services and Microsoft Word

by Keith Bugg



Example 1:



sSelection = Selection

iStart = Selection.Range.Start  ' save the highlighted address

iEnd = Selection.Range.End



Example 2:



sSelection = Selection

iStart = Selection.Range.Start

iEnd = Selection.Range.End

iLastChar = Asc(Mid(sSelection, (iEnd - iStart), 1))

If iLastChar = 32 Or iLastChar = 116 Then

        iEnd = iEnd - 1

        sSelection = Left(sSelection, (iEnd - iStart) + 1)

End If





Example 3:



Dim sMapParams() As String

sMapParams = Split(sMapURL, "|")

Dim obj As InlineShape

Dim sNewImage As String

'

szTempDir = Environ("TEMP")     ' get temp. folder

szTempFileName = fso.GetTempName() ' get a temp. filename

'

' remove the .tmp extension and change to .jpg

'

szTempFileName = Left(szTempFileName, 9)

szTempFileName = szTempDir & "\" & szTempFileName & "jpg"

sNewImage = sMapParams(0) '

err = URLDownloadToFile(0, sNewImage, szTempFileName, 0, 0)

Selection.InlineShapes.AddPicture FileName:=szTempFileName, 

                                             SaveWithDocument:=True





Listing One



Private Declare Function URLDownloadToFile Lib "urlmon" Alias _

"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _

ByVal szFileName As String, ByVal dwReserved As Long, _

ByVal lpfnCB As Long) As Long



' This is the prototype for calling a Web service from inside a Word doc

Sub Test()

    Dim sSelection As String

    Dim sValidAddr, sTheme, sScale, sSize As String

    Dim iStart, iEnd, iResult, iLastChar, k As Integer

    Dim selOrig As Selection

    Dim sMapURL As String

    Dim bLoop As Boolean

    Dim myMap As clsws_GetMap

    Dim myMapProps As struct_MapSettings

    Dim localFileName, szTempDir, szTempFileName As String

    Dim fso As New FileSystemObject

    Dim err As Long

    '

    Set selOrig = Selection

    sSelection = Selection

    iStart = Selection.Range.Start

    iEnd = Selection.Range.End

    iLastChar = Asc(Mid(sSelection, (iEnd - iStart), 1))

    ' Code to strip off a trailing <cr>, comma, space, or period

    bLoop = True

    k = 0

    Do While bLoop    '

        iLastChar = Asc(Mid(sSelection, ((iEnd - k) - iStart), 1))

        If ((iLastChar >= 65 And iLastChar <= 90) Or 

                                (iLastChar >= 97 And iLastChar <= 122)) Then

            bLoop = False

        Else

            k = k + 1

        End If

    Loop

    sSelection = Left(sSelection, ((iEnd - k) - iStart))



    Dim myGetAddress As clsws_GetAddress

    Dim myAddrInfo As struct_AddressInfo

    Dim mySearchInfo As struct_SearchProperties

    

    Set mySearchInfo = New struct_SearchProperties

    Set myGetAddress = New clsws_GetAddress

    

    mySearchInfo.AddressStyle = "FullAddress"

    mySearchInfo.SearchMethod = "Exact"

    mySearchInfo.SpatialSearch = "None"

    mySearchInfo.FullAddress = sSelection

   

    Set myAddrInfo = myGetAddress.wsm_GetAddressInfo(mySearchInfo)

    sValidAddr = myAddrInfo.MatchStatus

    If sValidAddr = "Exact" Then

        '

        UserForm1.Show (vbModal) 'show UserForm1

        iResult = UserForm1.sResult

        sTheme = UserForm1.sTheme

        sScale = UserForm1.sScale

        sSize = UserForm1.sSize

        

        Unload UserForm1 ' transfered values, so safe to unload the Form

        ' does user want a map or an owner card?

        Select Case iResult

            Case 1

                '   *************************

                '   *   User wants a map    *

                '   *************************

                Selection.Paragraphs(1).Range.InsertParagraphAfter

                Selection.MoveDown ' this is required!

                'now get the map

                Set myMap = New clsws_GetMap

                Set myMapProps = New struct_MapSettings

                myMapProps.MapScale = sScale    ' set scale user picked

                myMapProps.MapType = sTheme     ' set theme user picked

                Select Case sSize

                    Case "Small"

                        myMapProps.MapHeight = 300

                        myMapProps.MapWidth = 400

                        '

                    Case "Medium"

                        myMapProps.MapHeight = 400

                        myMapProps.MapWidth = 500

                        '

                    Case "Large"

                        myMapProps.MapHeight = 500

                        myMapProps.MapWidth = 600

                End Select

                'myMapProps.UseExtents = False

                 myMapProps.UseScale = True

                 

                 sMapURL = myMap.wsm_GetMapByAddressMSLink(CLng(Val

                                     (myAddrInfo.AddrMSLINK)), myMapProps)

                 Dim sMapParams() As String

                 sMapParams = Split(sMapURL, "|")

                 Dim obj As InlineShape

                 Dim sNewImage As String

                 '

                 szTempDir = Environ("TEMP")        ' get temp. folder

                 szTempFileName = fso.GetTempName() ' get temp file name

                 ' remove the .tmp extension and change to .jpg

                 szTempFileName = Left(szTempFileName, 9)

                 szTempFileName = szTempDir & "\" & szTempFileName & "jpg"

                      sNewImage = sMapParams(0) '

                      err = URLDownloadToFile(0,sNewImage,szTempFileName,0,0)

                       Selection.InlineShapes.AddPicture 

                             FileName:=szTempFileName, SaveWithDocument:=True

                    Selection.MoveLeft Unit:=wdCharacter, Count:=1, 

                                                          Extend:=wdExtend

    With Selection.InlineShapes(1)

        With .Borders(wdBorderLeft)

            .LineStyle = wdLineStyleSingle

            .LineWidth = wdLineWidth050pt

            .Color = wdColorAutomatic

        End With

        With .Borders(wdBorderRight)

            .LineStyle = wdLineStyleSingle

            .LineWidth = wdLineWidth050pt

            .Color = wdColorAutomatic

        End With

        With .Borders(wdBorderTop)

            .LineStyle = wdLineStyleSingle

            .LineWidth = wdLineWidth050pt

            .Color = wdColorAutomatic

        End With

        With .Borders(wdBorderBottom)

            .LineStyle = wdLineStyleSingle

            .LineWidth = wdLineWidth050pt

            .Color = wdColorAutomatic

        End With

        .Borders.Shadow = False

    End With

    With Options

        .DefaultBorderLineStyle = wdLineStyleSingle

        .DefaultBorderLineWidth = wdLineWidth050pt

        .DefaultBorderColor = wdColorAutomatic

    End With

                     ' restore the highlight to orig. addr string

                     ActiveDocument.Range(iStart, iEnd).Select

                ' now delete the file in the TEMP directory

                fso.DeleteFile szTempFileName, False

                 

            Case 2  ' user wants OWNER CARD info, no Parcel ID

                Selection.Paragraphs(1).Range.InsertParagraphAfter

                Selection.MoveDown ' this is required!

                Set myMap = New clsws_GetMap

                Set myMapProps = New struct_MapSettings

                



                

                myMapProps.MapScale = sScale    ' set scale user picked

                myMapProps.MapType = sTheme     ' set theme user picked

    

                myMapProps.MapHeight = 500

                myMapProps.MapWidth = 600

                myMapProps.UseScale = True

                

                sMapURL = myMap.wsm_GetMapByAddressMSLink(CLng(

                                    Val(myAddrInfo.AddrMSLINK)), myMapProps)

                Selection.InsertAfter Text:=vbCrLf

                Selection.InsertAfter Text:=CStr(myAddrInfo.Owner) & vbCrLf

                Selection.InsertAfter Text:=

                                 CStr(myAddrInfo.OwnerMailingAddr_1) & vbCrLf

                Selection.InsertAfter Text:=

                                 CStr(myAddrInfo.OwnerMailingAddr_2) & vbCrLf

                '

                ActiveDocument.Range(iStart, iEnd).Select   ' restore original selection

        Case 3  ' user wants OWNER CARD info, and Parcel ID

                Selection.Paragraphs(1).Range.InsertParagraphAfter

                Selection.MoveDown ' this is required!

                Set myMap = New clsws_GetMap

                Set myMapProps = New struct_MapSettings

                

                myMapProps.MapScale = sScale    ' set scale user picked

                myMapProps.MapType = sTheme     ' set theme user picked

                myMapProps.MapHeight = 500

                        myMapProps.MapWidth = 600

                'myMapProps.UseExtents = False

                myMapProps.UseScale = True

                

                sMapURL = myMap.wsm_GetMapByAddressMSLink(CLng(

                                 Val(myAddrInfo.AddrMSLINK)), myMapProps)

                Selection.InsertAfter Text:=vbCrLf

                Selection.InsertAfter Text:=CStr(myAddrInfo.Owner) & vbCrLf

                Selection.InsertAfter Text:=

                                CStr(myAddrInfo.OwnerMailingAddr_1) & vbCrLf

                Selection.InsertAfter Text:=

                                 CStr(myAddrInfo.OwnerMailingAddr_2) & vbCrLf

                Selection.InsertAfter Text:=CStr(myAddrInfo.ParcelID)

                Selection.InsertAfter Text:=vbCrLf

                '

                ActiveDocument.Range(iStart, iEnd).Select   

                                              ' restore original selection

        End Select

    Else

        MsgBox "That address is NOT VALID!", vbCritical Or vbOKOnly

    End If

End Sub













4



