vba - 地图点 Excel VBA。为什么使用的 RAM 会增加直到冻结脚本？

Question

我在 VBA 中实现了两个函数

formatAddress() 获取一个地址（字符串）并返回一个字符串数组，每个字符串都有一段街道地址。示例：[via] [n:civico][citta].. ecc
getPoint 它使用 formatAddress() 函数返回的数组来计算将放在当前单元格上的地理坐标。2.调用 1.各街道地址计算。

在脚本运行时，每次调用 2. MapPoint 使用的 RAM 都会像指数一样增加，直到使用 810MB RAM 冻结脚本执行，并返回典型 Microsoft 风格的错误代码，一般错误没有文档。“Si è verificato un errore Generato dal sistema o da un componenteesterno”“发生错误，由系统或外部组件生成”

如果存在管理此错误的方法，我查找了 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

我评论了一些代码以仅在工作时显示该功能并生成冻结

谢谢

score 1 · Accepted Answer

在路上只有一个 iPad，所以我看不到大部分代码；但是您描述的是 MapPoint API 的已知行为。基本上，垃圾收集器针对 GUI 用户进行了优化，而不是编程使用。一种简单的垃圾收集方法将是一个很好的解决方案，但尚未实施。手动最小化和最大化 MapPoint 是一种已知的解决方法，但要以编程方式执行此操作，您必须将 Windows 消息发送到 MapPoint 主窗口（在 Win7/Vista 中很难） - API 最小化/最大化方法是不够的。

如果您将 MapPoint 用作外部应用程序，则定期重新启动它是另一种解决方案 - 这就是我的 MPMilage 产品所做的。

另一件重要的事情是要非常干净地处理 MapPoint 对象。尽快清理、释放物体等。确实发生的垃圾回收将永远不会回收有引用的对象，因此一旦完成所有引用，就将它们设置为 0 或 NULL。这可以对 MapPoint 的内存增长产生很大的影响，但对于真正的大批量作业，它只会延迟不可避免的情况。

vba - 地图点 Excel VBA。为什么使用的 RAM 会增加直到冻结脚本？

1 回答 1

Related

Reference