Excel MAcro Run(2003) to a different machine ( 2000)- Run time error 1004

  • Thread starter Thread starter Novice
  • Start date Start date
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: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
 
I think you have posted in the wrong newsgroup: this newsgroup is for
Macros in Microsoft Access (a database application in the Microsoft Office
suite) and not Excel Macros.

Suggest you re-post your question in one of the relevant newsgroups for
Excel (VBA).
 
Back
Top