N
Novice
Here is the code which iam using to export mappoint routes in a
sequence.Its working in Excel 2003 but Some how there is a runtime
error 1004 on this code . this macro has some excel 2003 code not
compatible with 2000. Any Help is appreciated. Thanks
Dim oMpApp As MapPoint.Application
Sub Command_Click()
Dim sTemp As Shape
Dim ws As Worksheet
' Attach to running instance of MapPoint
Set oMpApp = GetObject(, "MapPoint.Application")
' Retrieve the active map
Dim oMap As MapPoint.Map
Set oMap = oMpApp.ActiveMap
'Dim LIST1 As ListObject
Dim workingcell As Range
Dim oLoc As MapPoint.Location
Dim oDs As MapPoint.DataSet
Dim oRs As MapPoint.Recordset
Dim directions As String
Dim ACTIVEROUTE As MapPoint.Route
Set oMap = oMpApp.ActiveMap
Set ACTIVEROUTE = oMap.ACTIVEROUTE
Dim oWpt As MapPoint.Waypoint
Dim iMyFreeFile As Integer
Dim SEQ, STREET, CITY, ST, ZIP, PATH As String
Dim var1
SEQ = "MAPPOINTSEQ"
STREET = "NAME"
State = "NAME2"
ZIP = "ZIP"
' get a freefile number
iMyFreeFile = FreeFile()
PATH = ActiveWorkbook.PATH
PATH = PATH + "\ROUTE.TXT"
Debug.Print PATH
' open the text file
Open PATH For Output As #iMyFreeFile
Write #iMyFreeFile, SEQ & ", " & STREET & ", " & State
'Write #iMyFreeFile, string1
' write whatever you want
For Each oWpt In oMap.ACTIVEROUTE.Waypoints
'LIST1.AddItem
Write #iMyFreeFile, oWpt.ListPosition & ", " & oWpt.Name; ""
'Debug.Print " seq, " & oWpt.ListPosition & ", " & oWpt.Name
Next oWpt
oMap.CopyDirections
' Print #iMyFreeFile, clipboard
Close #iMyFreeFile
oMap.CopyDirections
Worksheets("sheet1").Select
Cells(10, 1).Select
ActiveSheet.Paste
ExportToTextFile "route2.txt", ",", False
Worksheets("sheet1").Select
Rows("5:5").Select
Cells.Select
Range("A358").Activate
Rows("5:10000").Select
Selection.Delete Shift:=xlUp
Application.CutCopyMode = False
Set newbook = Workbooks.Add
With newbook
.Title = "oPTIMIZEDROUTE"
.Subject = "ROUTE"
.SaveAs FileName:="OPTIMIZEDROUTE.xls"
End With
ActiveWorkbook.Saved = True
ImportTextFile "route2.txt", ","
Worksheets("SHEET1").Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Rows("1:1").Select
Selection.Font.Bold = True
Cells.Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Replace What:="depart", Replacement:="CUSTOMER STOP ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Replace What:="ARRIVE", Replacement:="CUSTOMER STOP
", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Replace What:="AT", Replacement:="CUSTOMER STOP ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.EntireColumn.AutoFit
Rows("1:9").Select
Selection.Delete Shift:=xlUp
Columns("a:a").ColumnWidth = 8.12
Columns("b:b").ColumnWidth = 8.12
Columns("c:c").ColumnWidth = 30.12
Columns("D").ColumnWidth = 10.89
Columns("e:e").ColumnWidth = 8.89
ActiveWorkbook.Saved = True
Set newbook = Workbooks.Add
With newbook
.Title = "OptimizedRoutesequence"
.Subject = "ROUTE"
.SaveAs FileName:="optimizedroute_sequence.xls"
End With
ActiveWorkbook.Saved = True
ImportTextFile PATH, "_"
Worksheets("SHEET1").Select
Cells.Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "MAPPOINT SEQUENCE"
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "STOP"
Range("c1").Select
ActiveCell.FormulaR1C1 = "PCS"
Range("d1").Select
ActiveCell.FormulaR1C1 = "REP NAME"
Range("e1").Select
ActiveCell.FormulaR1C1 = "STREET"
Range("f1").Select
ActiveCell.FormulaR1C1 = "CITY"
Range("g1").Select
ActiveCell.FormulaR1C1 = "ZIP"
Range("h1").Select
ActiveCell.FormulaR1C1 = "ACCOUNT"
Cells.Select
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.EntireColumn.AutoFit
ActiveWorkbook.Saved = True
Application.CutCopyMode = False
MsgBox "THE FINAL 2 EXCEL FILES ARE IN " & ActiveWorkbook.PATH
End Sub
sequence.Its working in Excel 2003 but Some how there is a runtime
error 1004 on this code . this macro has some excel 2003 code not
compatible with 2000. Any Help is appreciated. Thanks
Dim oMpApp As MapPoint.Application
Sub Command_Click()
Dim sTemp As Shape
Dim ws As Worksheet
' Attach to running instance of MapPoint
Set oMpApp = GetObject(, "MapPoint.Application")
' Retrieve the active map
Dim oMap As MapPoint.Map
Set oMap = oMpApp.ActiveMap
'Dim LIST1 As ListObject
Dim workingcell As Range
Dim oLoc As MapPoint.Location
Dim oDs As MapPoint.DataSet
Dim oRs As MapPoint.Recordset
Dim directions As String
Dim ACTIVEROUTE As MapPoint.Route
Set oMap = oMpApp.ActiveMap
Set ACTIVEROUTE = oMap.ACTIVEROUTE
Dim oWpt As MapPoint.Waypoint
Dim iMyFreeFile As Integer
Dim SEQ, STREET, CITY, ST, ZIP, PATH As String
Dim var1
SEQ = "MAPPOINTSEQ"
STREET = "NAME"
State = "NAME2"
ZIP = "ZIP"
' get a freefile number
iMyFreeFile = FreeFile()
PATH = ActiveWorkbook.PATH
PATH = PATH + "\ROUTE.TXT"
Debug.Print PATH
' open the text file
Open PATH For Output As #iMyFreeFile
Write #iMyFreeFile, SEQ & ", " & STREET & ", " & State
'Write #iMyFreeFile, string1
' write whatever you want
For Each oWpt In oMap.ACTIVEROUTE.Waypoints
'LIST1.AddItem
Write #iMyFreeFile, oWpt.ListPosition & ", " & oWpt.Name; ""
'Debug.Print " seq, " & oWpt.ListPosition & ", " & oWpt.Name
Next oWpt
oMap.CopyDirections
' Print #iMyFreeFile, clipboard
Close #iMyFreeFile
oMap.CopyDirections
Worksheets("sheet1").Select
Cells(10, 1).Select
ActiveSheet.Paste
ExportToTextFile "route2.txt", ",", False
Worksheets("sheet1").Select
Rows("5:5").Select
Cells.Select
Range("A358").Activate
Rows("5:10000").Select
Selection.Delete Shift:=xlUp
Application.CutCopyMode = False
Set newbook = Workbooks.Add
With newbook
.Title = "oPTIMIZEDROUTE"
.Subject = "ROUTE"
.SaveAs FileName:="OPTIMIZEDROUTE.xls"
End With
ActiveWorkbook.Saved = True
ImportTextFile "route2.txt", ","
Worksheets("SHEET1").Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Rows("1:1").Select
Selection.Font.Bold = True
Cells.Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Replace What:="depart", Replacement:="CUSTOMER STOP ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Replace What:="ARRIVE", Replacement:="CUSTOMER STOP
", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Replace What:="AT", Replacement:="CUSTOMER STOP ",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.EntireColumn.AutoFit
Rows("1:9").Select
Selection.Delete Shift:=xlUp
Columns("a:a").ColumnWidth = 8.12
Columns("b:b").ColumnWidth = 8.12
Columns("c:c").ColumnWidth = 30.12
Columns("D").ColumnWidth = 10.89
Columns("e:e").ColumnWidth = 8.89
ActiveWorkbook.Saved = True
Set newbook = Workbooks.Add
With newbook
.Title = "OptimizedRoutesequence"
.Subject = "ROUTE"
.SaveAs FileName:="optimizedroute_sequence.xls"
End With
ActiveWorkbook.Saved = True
ImportTextFile PATH, "_"
Worksheets("SHEET1").Select
Cells.Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "MAPPOINT SEQUENCE"
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "STOP"
Range("c1").Select
ActiveCell.FormulaR1C1 = "PCS"
Range("d1").Select
ActiveCell.FormulaR1C1 = "REP NAME"
Range("e1").Select
ActiveCell.FormulaR1C1 = "STREET"
Range("f1").Select
ActiveCell.FormulaR1C1 = "CITY"
Range("g1").Select
ActiveCell.FormulaR1C1 = "ZIP"
Range("h1").Select
ActiveCell.FormulaR1C1 = "ACCOUNT"
Cells.Select
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.EntireColumn.AutoFit
ActiveWorkbook.Saved = True
Application.CutCopyMode = False
MsgBox "THE FINAL 2 EXCEL FILES ARE IN " & ActiveWorkbook.PATH
End Sub