vba - マップポイントエクセル VBA. スクリプトをフリーズするまで RAM の使用量が増えるのはなぜですか?

Question

VBAで2つの関数を実装しました

formatAddress() は住所 (文字列) を取得し、文字列の配列を返します。これらのそれぞれには番地のセクションがあります。例: [via] [n:civico][citta].. ecc
getPoint 返された formatAddress() 関数の配列を使用して、現在のセルに配置される地理座標を計算します。2. は 1. 番地ごとに呼び出して計算します。

スクリプトの実行中、MapPoint が使用する RAM は指数関数的に増加し、810MB の RAM を使用してスクリプトの実行がフリーズし、典型的な Microsoft スタイルの一般的なエラーコードをドキュメントなしで返します。「Si è verificato un errore generato dal sistema o da un componenteesterno」「エラーが発生しました。システムまたは外部コンポーネントによって生成されました」

このエラーを管理する方法が存在する場合、マイクロソフトの参照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 を外部アプリケーションとして使用している場合は、定期的に再起動することも別の解決策です。これが私の MPMiage 製品の機能です。

もう 1 つの重要なことは、MapPoint オブジェクトの処理を非常にクリーンにすることです。オブジェクトのクリーンアップ、解放などをできるだけ迅速に行います。発生するガベージコレクションは、オブジェクトへの参照がある間は決してオブジェクトを再利用しないため、すべての参照を使い終わったらすぐに 0 または NULL に設定してください。これは、MapPoint のメモリの増加に大きな違いをもたらす可能性がありますが、非常に大きなバッチジョブの場合、必然的に遅延するだけです。

vba - マップポイント エクセル VBA. スクリプトをフリーズするまで RAM の使用量が増えるのはなぜですか?

1 に答える 1

Related

Reference

vba - マップポイントエクセル VBA. スクリプトをフリーズするまで RAM の使用量が増えるのはなぜですか?