MapPoint Excel VBA. Почему используемая оперативная память увеличивается до тех пор, пока скрипт не заморозится?

Я реализовал две функции в VBA

  1. formatAddress() получает адрес (строку) и возвращает массив строк, каждая из которых имеет раздел адреса улицы. Пример: [через] [n:civico][citta].. ecc

  2. getPoint использует возвращенный массив функции formatAddress() для вычисления географических координат, которые будут помещены в текущие ячейки. 2. вызывает 1. каждый адрес улицы для расчета.

Во время выполнения скрипта каждый вызов 2. ОЗУ, используемого MapPoint, увеличивается, как экспоненциальное, до тех пор, пока выполнение скрипта не замораживается с использованием 810 МБ ОЗУ, и возвращается код ошибки в типичном стиле Microsoft, общая ошибка без документации. "Si è verificato un errore generateato dal sistema o da un componente esterno" "Произошла ошибка, она была сгенерирована системой или внешним компонентом"

Я искал ссылки Microsoft http://msdn.microsoft.com/en-us/library/aa723478, если существует способ справиться с этой ошибкой (я думаю, что при каждом вызове текущее исчисление не освобождает память) без результатов.

 Option Explicit
 MIMO V 1.0 project Script VBA Data Manager Script
' Script Purpose
'
' This script was implemented for merge two specific Tables of in one.
' the methods and functions use a supplementary software is called
' Microsoft MapPoint 2010, fundamental to calculate extra data that
' will add at the merged table.
'
' Scopo dello script
'
' questo script è stato scritto per fondere due tabelle specifiche in una.
' i metodi e le funzioni usano un software supplementare chiamato
' Microsoft Map Point 2010, fondamentale percalcolare i dati aggiuntivi che
' verranno aggiunti alla tabella prodotta.
Const startColumn As Integer = 1
Const rowStart As Integer = 3 'per passare dagli'indici agli elementi
Const cellBlank As String = "" 'per identificare le celle vuote
' le seguenti te istruzioni avviano MapPoint
Dim App         As New MapPoint.Application
Dim map         As MapPoint.map
Dim route       As MapPoint.route

'index of the columns to copy: function joinTables()
Const ADDR As Integer = 11      ' indirizzo tab clienti
Const ID2 As Integer = 6        ' codice Agenzia tab Agenzie
Const ADDA As Integer = 9       ' indirizzo tab agenzia
Const CAPA As Integer = 10      ' CAP Agenzia
Const CITTA As Integer = 12     ' Citta Agenzia
Const PROVA As Integer = 14     'Provincia Agenzia
Const LONA As Integer = 25      ' Logitudine agenzia
Const LATA As Integer = 26      ' latitudine agenzia
Const CID As Integer = 1        'colonne di destinazione per la copia
Const CADDR As Integer = 2
Const CCAP As Integer = 3
Const CCOM As Integer = 4
Const CPRO As Integer = 5
Const CLON As Integer = 6
Const CLAT As Integer = 7
Const CID2 As Integer = 8
Const CADDA As Integer = 9
Const CCAPA As Integer = 10
Const CCITTA As Integer = 11
Const CPROVA As Integer = 12
Const CLONA As Integer = 13
Const CLATA As Integer = 14
Const SPAZIO As Integer = 15
Const TEMPO As Integer = 16
'distanceST()
Dim pointA       As MapPoint.Location
Dim pointB       As MapPoint.Location
Dim spT(2) As String ' (0)space ; (1)time
'getPoint()
Dim pt(7) As String ' array temporaneo
Dim lPoint       As MapPoint.Location
Dim fAddress()  As String
'formatAddress()
Const faLenght As Integer = 5 ' dimenzione dell'array string di ritorno
Dim tempASrt() As String
Dim lenght As Integer
Dim counter As Integer
Dim FAIndex As Integer
Dim tmpFmtAdd(faLenght) As String
' metodo prinipale dal quale parte l'esecuzione dell'intero programma
Sub main()
Const rowOffsetSh1 As Integer = 3 ' start point record of  clienti's table
Const rowOffsetSh2 As Integer = 2 ' start point record of agenzie's table
Const offsetRecord As Integer = 0 ' starting record to work

' initialize application
App.Visible = False
App.UserControl = True
Set map = App.ActiveMap
Set route = map.ActiveRoute
MsgBox joinTables(rowOffsetSh1 + offsetRecord, rowOffsetSh2)
' le seguenti tre istruzioni terminano il programma MapPoint
map.Saved = True
App.Quit
Set App = Nothing
End Sub


'join input tables in output sheet with additional data
Private Function joinTables(orsh1 As Integer, orsh2 As Integer) As String
Dim i As Integer ' indice generico
Dim link As Integer 'join fra le tabelle, necessario per la simulazione di join
' variabili temporanee per il calcolo dei dati
'Dim fADDR() As String
Dim point() As String ' conterra tutti i dati relativi ad un certo indirizzo
Dim dist() As String
Dim Sh3Off As Integer
i = orsh1 ' imposto l'indice con il valore della riga di partenza
passato come parametro di funz
         ' la tab clienti parte dalla 3 riga mentre la tab ottenuta da 2
Sh3Off = i - 1 ' offset necessario per lasciare spazio alla riga prima
di titolo nella tab uscita
' proseguo mentre la riga corrente della tabella 1 non è vuota
Do While Worksheets(1).Cells(i, startColumn) <> "" And
Worksheets(1).Cells(i, startColumn) <> " "
Worksheets(3).Cells(Sh3Off, CID) = Worksheets(1).Cells(i, startColumn)
    'copio CDO cliente del foglio 1 nel foglio 3
'Worksheets(3).Cells(Sh3Off, CID).Interior.Color = RGB(255, 0, 0)
'MsgBox "prima"
point = getPoint(Worksheets(1).Cells(i, ADDR))
    'calcolo le coordinate per l'indirizzo passato
'MsgBox "dopo"
'Worksheets(3).Cells(Sh3Off, CADDR) = point(0)
     'copio gl'indirizzi formattati del foglio 1 nel foglio 3
'Worksheets(3).Cells(Sh3Off, CCAP) = point(2)
     'copio i CAP formattati del foglio 1 nel foglio 3
'Worksheets(3).Cells(Sh3Off, CCOM) = point(3)
     'copio i Comuni formattati del foglio 1 nel foglio 3
'Worksheets(3).Cells(Sh3Off, CPRO) = point(4)
     'copio le Provincie formattati del foglio 1 nel foglio 3
'Worksheets(3).Cells(Sh3Off, CLON) = point(5)
     'copio la longitudine per l'indirizzo passato
'Worksheets(3).Cells(Sh3Off, CLAT) = point(6)
     'copio la latitudine per l'indirizzo passato
'Worksheets(3).Cells(Sh3Off, CID2) = Worksheets(1).Cells(i, ID2)
     'copio l'id dell'agenzia nella nuova tabella
' calcolo la distanza spazio-temporale
'dist = distanceST(point(5), point(6), Worksheets(2).Cells(link,
LONA), Worksheets(2).Cells(link, LATA))
'Worksheets(3).Cells(Sh3Off, SPAZIO) = dist(0)
'Worksheets(3).Cells(Sh3Off, TEMPO) = dist(1)
'link = linkForeingKey(Worksheets(1).Cells(i, ID2), orsh2, 2,
startColumn) 'calcolo la posizione dell'ID agenzia in tab agenz.
relazionata al cliente
'Worksheets(3).Cells(Sh3Off, CADDA) = Worksheets(2).Cells(link, ADDA)
'Worksheets(3).Cells(Sh3Off, CCAPA) = Worksheets(2).Cells(link, CAPA)
'Worksheets(3).Cells(Sh3Off, CCITTA) = Worksheets(2).Cells(link, CITTA)
'Worksheets(3).Cells(Sh3Off, CPROVA) = Worksheets(2).Cells(link, PROVA)
'Worksheets(3).Cells(Sh3Off, CLONA) = Worksheets(2).Cells(link, LONA)
'Worksheets(3).Cells(Sh3Off, CLATA) = Worksheets(2).Cells(link, LATA)
i = i + 1
Sh3Off = Sh3Off + 1
Loop
joinTables = "Done. (^.^) "
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'funzione che prende un indirizzo (string) in un certo formato valido
'e ritorna un array (String) con le relative informazioni seguenti
'
' VIA | N_CIVICO | CAP | CITTA | PROVINCIA | LONG | LAT
' (0) | (1)      | (2) | (3)   | (4)       | (5)  | (6)
'
Private Function getPoint(address As String) As String()
If address <> "" And address <> " " Then
fAddress = formatAddress(address) ' converte l'indirizzo in un array
Set lPoint = map.FindAddressResults(fAddress(0), fAddress(3), , ,
fAddress(2), geoCountryItaly).Item(1)
'MsgBox fAddress(0) & ", " & fAddress(2) & " " & fAddress(3) & " " & fAddress(4)
'Set lPoint = map.findResults(fAddress(0) & ", " & fAddress(2) & " " &
fAddress(3) & " " & fAddress(4)).Item(1)
pt(0) = fAddress(0)
pt(1) = fAddress(1)
pt(2) = fAddress(2)
pt(3) = fAddress(3)
pt(4) = fAddress(4)
pt(5) = Format(lPoint.Longitude, "#,##0.000000")
pt(6) = Format(lPoint.Latitude, "#,##0.000000")
getPoint = pt
Else
MsgBox " Warning! Function getGPSPoint():: NO INPUT DATA"
getPoint = pt
End If
getPoint = pt
End Function
' funzione che prende un ID di un foglio e ritorna la sua
' posizione in Integer nella colonna del altro foglio passata
' come indice parametro di funzione
Private Function linkForeingKey(Target As String, offset As Integer,
sheet As Integer, column As Integer) As Integer
Dim i As Integer
If Target <> "" And Target <> " " And offset > 0 And sheet > 0 And
column > 0 Then
i = offset
Do While Worksheets(sheet).Cells(i, column) <> "" And
Worksheets(sheet).Cells(i, column) <> " "
If Worksheets(sheet).Cells(i, column) = Target Then
'MsgBox "foreingKey[" & Worksheets(sheet).Cells(i, column) & "]  row["
& i & "]" '[ pass ]
linkForeingKey = i
End If
i = i + 1
Loop
Else
MsgBox " Warning! Function linkForeingKey():: NO CORRECTLY DATA"
linkForeingKey = 0
End If
End Function
' funzione che prende come parametri le coordinate GPS dei punti da valutare
' restituisce un array di stringhe con distanza in KM e tempo in min tra i punti
' distanceST(...)(0) // space
' distanceST(...)(1) // time
Private Function distanceST(LONA As String, LATA As String, lonB As
String, latB As String) As String()
If LATA <> " " And LONA <> " " And latB <> " " And lonB <> " " Then
'calcolo i punti nella mappa
Set pointA = map.GetLocation(LATA, LONA)
Set pointB = map.GetLocation(latB, lonB)
'calcolo la rotta
route.Waypoints.Add pointA
route.Waypoints.Add pointB
route.Calculate
'calcolo della distanza in KM
spaceTime(0) = route.Distance
'calcolo della distanza in Min
spaceTime(1) = Left(route.DrivingTime / geoOneMinute, 5)
'MsgBox "distanza: A[LO " & LONA & "LA " & LATA & "] B[ LO " & lonB &
"LA " & latB & "] KM[" & spaceTime(0) & "] T[" & spaceTime(1) & "]"
'route.Waypoints.Item(2).Delete
'route.Waypoints.Item(1).Delete
route.Clear
Set pointA = Nothing
Set pointB = Nothing
map.Saved = False
distanceST = spT
Else
MsgBox " Warning! Function distanceST():: NO INPUT DATA"
distanceST = spT
End If
'distanceST = spaceTime
End Function
'funzione che prende una stringa che è un indirizzo
'e ritorna le componenti dell'indirizzo nella forma
' VIA | N_CIVICO | CAP | CITTA | PROVINCIA
' (0) | (1)      | (2) | (3)   | (4)
Private Function formatAddress(address As String) As String()
If address <> "" Then
FAIndex = faLenght - 1
counter = 4 ' perche 4 sono bs citta cap n_civico, la cui posizione non varia
address = Replace(address, ";", " ") ' elimina dall'indirizzo il fastidioso ';'
address = Replace(address, ",", " ") ' elimina dall'indirizzo il fastidioso ','
tempASrt = Split(address, " ")
lenght = UBound(tempASrt)
Do While lenght > -1
If tempASrt(lenght) <> "" Then
If counter > 0 Then ' sistemo subito le ultime quattro n_civico cap
citta provincia
tmpFmtAdd(FAIndex) = tempASrt(lenght)
FAIndex = FAIndex - 1
counter = counter - 1
Else ' sistemo le rimanenti parole, cioè la via
tmpFmtAdd(0) = tempASrt(lenght) + " " + tmpFmtAdd(0)
End If
End If
lenght = lenght - 1
Loop
formatAddress = tmpFmtAdd
Else
MsgBox " Warning! Function formatAddress():: NO INPUT DATA"
End If
formatAddress = tmpFmtAdd
End Function

исходный код размещен на

https://docs.google.com/document/d/161srj6Zz0B2x_BHQV85QQft-JY55RK8oFwj3SLlUo9A/edit

Я прокомментировал некоторый код, чтобы показывать функцию только во время работы и генерировать зависание

Спасибо


excel vba mappoint
person nullpenguin    schedule 18.05.2012    source источник
comment
я не собираюсь читать так много кода - если вы не получили ответа и все еще хотите получить помощь, попробуйте воспроизвести ошибку с минимальным объемом кода.   -  person Aprillion    schedule 19.05.2012
comment
Правильно, я думаю, что ошибка генерируется только функцией getPoint(), как я указал. левые константы, функции (исключение для formatAddress) и закомментированный код работают нормально. цель этого кода - просто объединить листы Excel в один, добавив дополнительные данные, рассчитанные с помощью функции getPoint(). весь код работает до середины работы. в любом случае вы получите мой файл excel по электронной почте? если да, то как я могу отправить вам его? Спасибо за руку :)   -  person nullpenguin    schedule 19.05.2012

Ответы (1)


arrow_upward
1
arrow_downward

В дороге только с iPad, так что большую часть кода я не вижу; но то, что вы описываете, является известным поведением с API MapPoint. В основном сборщик мусора оптимизирован для пользователей с графическим интерфейсом, а не для использования в программировании. Простой метод сборки мусора был бы хорошим решением, но он не реализован. Ручное минимизация и максимизация MapPoint — известный обходной путь, но для того, чтобы сделать это программно, вы должны отправлять сообщения Windows в главное окно MapPoint (сложно в Win7/Vista) — методы минимизации/максимизации API недостаточны.

Если вы используете MapPoint как внешнее приложение, то его периодический перезапуск является еще одним решением — это то, что делает мой продукт MPMileage.

Другая важная вещь — быть очень аккуратным с обработкой объектов MapPoint. Очищайте, освобождайте объекты и т. д. как можно быстрее. Сборка мусора, которая происходит, никогда не вернет объект, пока на него есть ссылка, поэтому установите все ссылки в 0 или NULL, как только вы закончите с ними. Это может иметь большое значение для увеличения памяти MapPoint, но для действительно больших пакетных заданий это только отсрочит неизбежное.

person winwaed    schedule 19.05.2012