MS Word Macro

Inserts an address from an Image database with ODBC.

code written by:
23. December 1997 / Thomas Isaak / Minisoft AG

Sub InsertAddress()

ActiveDocument.Save

Dim CustomerNr, SQLString, SQLString1

CustomerNr = InputBox("Enter Customer Number", "Insert Address")

If CustomerNr <> "" Then

  Set AdrDoc = Documents.Add

  SQLString = "SELECT CUSTOMERS.CUSTOMER_NAME, "&_
    "CUSTOMERS.ADDRESS1, CUSTOMERS.ADDRESS2," & _
    "CUSTOMERS.CITY, CUSTOMERS.STATE, CUSTOMERS.COUNTRY "

  SQLString1 = "FROM TESTSAV3.CUSTOMERS CUSTOMERS "&_
    "WHERE (CUSTOMERS.CUSTOMER_NUMBER='" & CustomerNr & "')"

  AdrDoc.Range.InsertDatabase Format:=0, Style:=0, _
    LinkToSource:=False, _
    Connection:="DSN=MSDB", _
    SQLStatement:=SQLString, SQLStatement1:=SQLString1, _
    PasswordDocument:="", PasswordTemplate:="", _
    WritePasswordDocument:="", WritePasswordTemplate:="", _
    DataSource:="", From:=-1, To:=-1, _
    IncludeFields:=False

  Set Table1 = AdrDoc.Tables(1)
  ReDim TabCells(Table1.Range.Cells.Count)
  i = 1
  For Each TabCell In Table1.Range.Cells
    Set CellRange = TabCell.Range
    CellRange.MoveEnd Unit:=wdCharacter, Count:=-1
    TabCells(i) = CellRange.Text
    i = i + 1
  Next TabCell

  AdrDoc.Close (wdDoNotSaveChanges)

' Insert CUSTOMER_NAME
  Selection.TypeParagraph
  Selection.MoveUp Unit:=wdLine, Count:=1
  Selection.Range.InsertBefore TabCells(1)
  Selection.MoveDown Unit:=wdLine, Count:=1

' Insert ADDRESS1
  Selection.TypeParagraph
  Selection.MoveUp Unit:=wdLine, Count:=1
  Selection.Range.InsertBefore TabCells(2)
  Selection.MoveDown Unit:=wdLine, Count:=1

' Insert ADDRESS2
  If TabCells(3) <> "" Then
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Range.InsertBefore TabCells(3)
    Selection.MoveDown Unit:=wdLine, Count:=1
  End If

' Insert CITY
  Selection.TypeParagraph
  Selection.MoveUp Unit:=wdLine, Count:=1
  Selection.Range.InsertBefore TabCells(4)
  Selection.MoveDown Unit:=wdLine, Count:=1

' Insert STATE
  Selection.TypeParagraph
  Selection.MoveUp Unit:=wdLine, Count:=1
  Selection.Range.InsertBefore TabCells(5)
  Selection.MoveDown Unit:=wdLine, Count:=1

' Insert COUNTRY
  Selection.TypeParagraph
  Selection.MoveUp Unit:=wdLine, Count:=1
  Selection.Range.InsertBefore TabCells(6)
  Selection.MoveDown Unit:=wdLine, Count:=1

End If

End Sub