here we got an old DB on progress and we want to print labels from it using vs2012, we found that the mean to do this is by a WCF and a rdlc,
At localhost it runs great, I can get the labels printed and the log files show that all the information is ok, but when I run it on the server (by the progress DB or by the WcfTestClient.exe) it's giving me an error, my log file shows that the report is not ready for render, even when I run it using the same parameters,
I don't use any dataset because the report just need the parameters to print the labels.
Please don't be rude, I'm really new at this, 2 weeks ago I didn't know what was Wcf, rdlc, SSRS and nothing about that, this is all new for me so expect some noobish mistakes.
Here is the piece of code that runs well on localhost but not on server;
Public Class GoPrint
Shared Sub StartPrinting(ByVal vpdfname As String, ByVal vExt As String, ByVal vPDFPath As String, ByVal deviceInfo As String, ByVal StreamPath As String, ByVal vReportPath As String, ByVal vReportEmbedded As String, ByVal vPrinter As String, ByVal vParams As String) 'Viene de R4, inicia el proceso y manda parametros
On Error GoTo Issues
Registro("StartPrinting", "--------------------------------------------------------------")
Dim ErrorEnReferencias As Boolean = False
If IsNothing(vParams) Then
Registro("StartPrinting", "Error: Los parametros estaban vacios")
ErrorEnReferencias = True
End If
If Not File.Exists(vReportPath.Replace("|", "\")) Then
Registro("StartPrinting", "Error: No se encontro el path del reporte")
ErrorEnReferencias = True
End If
If Not File.Exists(vReportEmbedded.Replace("|", "\")) Then
Registro("StartPrinting", "Error: No se encontro el path del reporte incrustado")
ErrorEnReferencias = True
End If
If Not ErrorEnReferencias Then
Registro("StartPrinting", "No se encontraron errores en los parametros enviados")
Registro("StartPrinting", "Lista de parametros del reporte excepto vParams (Nombre,Valor):")
Registro("StartPrinting", " +vpdfname = " & vpdfname)
Registro("StartPrinting", " +vExt = " & vExt)
Registro("StartPrinting", " +vPDFPath = " & vPDFPath)
Registro("StartPrinting", " +deviceInfo = " & deviceInfo)
Registro("StartPrinting", " +StreamPath = " & StreamPath)
Registro("StartPrinting", " +vReportPath = " & vReportPath)
Registro("StartPrinting", " +vReportEmbedded = " & vReportEmbedded)
Registro("StartPrinting", " +vPrinter = " & vPrinter)
Dim qtyOfParams As Integer = (CountCharacters(vParams, "|"c) / 3)
Dim SplitParams() As String = vParams.Split(New Char() {"|"c})
Dim EtqParams() As ReportParameter = New ReportParameter(qtyOfParams - 1) {}
Registro("StartPrinting", "Lista de parametros (vParam) del reporte (Nombre,Valor,Visible):")
For count = 1 To qtyOfParams
If SplitParams(1 + (count * 3 - 3)).IndexOf("[#") <> -1 Then SplitParams(1 + (count * 3 - 3)) = EncodeBarcodes(SplitParams(1 + (count * 3 - 3)))
EtqParams(count - 1) = (New ReportParameter(CStr(SplitParams(0 + (count * 3 - 3))), CStr(SplitParams(1 + (count * 3 - 3))), SplitParams(2 + (count * 3 - 3))))
Registro("StartPrinting", " +" & CStr(SplitParams(0 + (count * 3 - 3))) & "," & CStr(SplitParams(1 + (count * 3 - 3))) & "," & SplitParams(2 + (count * 3 - 3)))
Next
Dim permissions As New PermissionSet(PermissionState.Unrestricted)
Dim MYreport As LocalReport = New LocalReport()
MYreport.SetBasePermissionsForSandboxAppDomain(permissions)
MYreport.ReportPath = vReportPath.Replace("|", "\") 'No puedo pasar \ como parametro y mando | para los paths
MYreport.ReportEmbeddedResource = vReportEmbedded.Replace("|", "\")
MYreport.DataSources.Clear()
If MYreport.IsReadyForRendering Then
Registro("StartPrinting", "MYreport.IsReadyForRendering = Si")
MYreport.SetParameters(EtqParams)
MYreport.Refresh()
Registro("StartPrinting", "Creacion del reporte local y asignacion de propiedades terminada")
Registro("StartPrinting", " +MYreport.SetBasePermissionsForSandboxAppDomain(permissions), unrestricted")
Registro("StartPrinting", " +MYreport.ReportPath = " & MYreport.ReportPath)
Registro("StartPrinting", " +MYreport.ReportPath = " & MYreport.ReportEmbeddedResource)
Registro("StartPrinting", " +MYreport.SetParameters(EtqParams), (Lista de parametros)")
Dim PrintReport = New Reporting
PrintReport.Export(MYreport, vpdfname, vExt, vPDFPath.Replace("|", "\"), deviceInfo, StreamPath.Replace("|", "\"))
Registro("StartPrinting", "Creacion de pdf y raw de impresion completa")
PrintReport.Print(vPrinter)
Else
Registro("StartPrinting", "MYreport.IsReadyForRendering = No")
End If
Registro("StartPrinting", "Proceso finalizado")
Registro("StartPrinting", "--------------------------------------------------------------")
End If
Issues:
Registro("StartPrinting", Err.Number & " " & Err.Description)
Registro("StartPrinting", "--------------------------------------------------------------")
End Sub
And here is what shows my log file,
Registro de Errores
StartPrinting; -------------------------------------------------------------- -- 12/26/2014 5:05:37 PM
StartPrinting; No se encontraron errores en los parametros enviados -- 12/26/2014 5:05:37 PM
StartPrinting; +Lista de parametros del reporte excepto vParams (Nombre,Valor): -- 12/26/2014 5:05:37 PM
StartPrinting; +vpdfname = TST00003_1_AmaLbl -- 12/26/2014 5:05:37 PM
StartPrinting; +vExt = pdf -- 12/26/2014 5:05:37 PM
StartPrinting; +vPDFPath = ||vsn2k841|WCFparaRPT|AmaLbl|PDF| -- 12/26/2014 5:05:37 PM
StartPrinting; +deviceInfo = <DeviceInfo><OutputFormat>EMF</OutputFormat><PageWidth>3in</PageWidth><PageHeight>5in</PageHeight><MarginTop>0in</MarginTop><MarginLeft>0in</MarginLeft><MarginRight>0in</MarginRight><MarginBottom>0in</MarginBottom></DeviceInfo> -- 12/26/2014 5:05:37 PM
StartPrinting; +StreamPath = ||vsn2k841|WCFparaRPT|AmaLbl|Stream| -- 12/26/2014 5:05:37 PM
StartPrinting; +vReportPath = ||vsn2k841|WCFparaRPT|AmaLbl|AmaLbl.rdlc -- 12/26/2014 5:05:37 PM
StartPrinting; +vReportEmbedded = ||vsn2k841|WCFparaRPT|AmaLbl|AmaLbl.rdlc -- 12/26/2014 5:05:37 PM
StartPrinting; +vPrinter = LaserESCLOG -- 12/26/2014 5:05:37 PM
StartPrinting; Lista de parametros (vParam) del reporte (Nombre,Valor,Visible): -- 12/26/2014 5:05:37 PM
StartPrinting; +PSFN,LOUISVILLE LADDER,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PSFA,855 DUNKS FERRY RD,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PSFZ,19020,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PSTN,AMAZON.COM.DEDC LLC,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PSTA,1 CENTERPOINT BLVD.,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PSTZ,19720,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PBCZ,*19720*,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PCar,UPSA,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PPro,Test ETQ,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PBol,435462,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PPO,TST00003,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PUPC,728865090928,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PQTY,3,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PCartonNo,1,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PCartonTo,1,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PBCPO,*TST00003*,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PBCSSCC,›˜€*hxa$CN4.^œ,True -- 12/26/2014 5:05:37 PM
StartPrinting; +PSSCC,00107288650435462014,True -- 12/26/2014 5:05:37 PM
StartPrinting; MYreport.IsReadyForRendering = No -- 12/26/2014 5:05:38 PM
StartPrinting; Proceso finalizado -- 12/26/2014 5:05:38 PM
StartPrinting; -------------------------------------------------------------- -- 12/26/2014 5:05:38 PM
StartPrinting; 0 -- 12/26/2014 5:05:38 PM
StartPrinting; -------------------------------------------------------------- -- 12/26/2014 5:05:38 PM
The only difference between this log and a working one is that the reports render and keep going on the printing process, I use the exact same parameters,
BTW, already got my dlls on the bin folder.
I finally got it working some days ago, I was ussing 2 dlls from Microsoft.reportviewer.common and microsoft.reportviewer.webforms, both v10, I was getting them also in my bin folder folder, however, once in the server those dlls weren't working, I had to use the common one v9 and the webform one v11 in order to get this working.
Related
I have the following code to create a progress bar in a PowerPoint presentation
Sub BarreDeProgression()
'Génère une barre de progression
'Valeurs à adapter selon besoin
Const Longueur As Single = 1 'Longueur totale de la barre (% de la longueur de la diapo (0.25 =25%))
Const Hauteur As Single = 0.02 'Hauteur totale de la barre (% de la hauteur de la diapo)
Const PositionX As Single = 0.1 'Position en X de la barre (% de la longueur de la diapo en partant de la gauche)
Const PositionY As Single = 0.05 'Position en Y de la barre (% de la hauteur de la diapo en partant de la gauche)
'Récupération des infos
Set Pres = ActivePresentation
H = Pres.PageSetup.SlideHeight
W = Pres.PageSetup.SlideWidth * Longueur
nb = Pres.Slides.Count
Counter = 1
'Pour chaque Slide
For Each SLD In Pres.Slides
'Supprime l'ancienne barre de progression
nbShape = SLD.Shapes.Count
del = 0
For a = 1 To nbShape
If Left(SLD.Shapes.Item(a - del).Name, 2) = "PB" Then
SLD.Shapes.Item(a - del).Delete
del = del + 1
End If
Next
'pose la nouvelle barre de progression
For i = 0 To nb - 1
Set OBJ = SLD.Shapes.AddShape(msoShapeChevron, (W * i / nb) + W / nb * (PositionX / 2), H * (1 - PositionY), (W / nb) * (1 - PositionX), H * Hauteur)
OBJ.Name = "PB" & i
OBJ.Line.Visible = msoFalse
If i + 1 = Counter Then
OBJ.Fill.ForeColor.RGB = RGB(156, 156, 156)
Else
OBJ.Fill.ForeColor.RGB = RGB(216, 32, 39)
End If
Next
Counter = Counter + 1
Next
End Sub
The problem is that code loops through all slide and create a progress bar in all slide, but I don't want the bar in the first, in the introduction and i the conclusion. How can I fix it ? I thought to add and if condition where I specify that the slide number should be greater than 4, but it did not work. Thanks in advance.
In the long run, you should get in the habit of declaring variables. An example in this code is Dim X As Integer. When you do this, the variable acquires the properties and methods of the declared object type. If you don't declare them, they are all variants, and the application must guess which properties and methods apply.
In this version of your code, I removed the variant variable SLD, since that will apply the code to all members of the slides collection. I replaced it with a count of the number of slides. Then I was able to come up with a conditional statement that leaves out the first 2 and the last slides. I also adjusted the calculation of the nb variable to reduce it by three. This ensures the number of shapes totals the number of slides that display the shapes.
Here's the revised code:
Sub BarreDeProgression()
Dim X As Integer
'Génère une barre de progression
'Valeurs à adapter selon besoin
Const Longueur As Single = 1 'Longueur totale de la barre (% de la longueur de la diapo (0.25 =25%))
Const Hauteur As Single = 0.02 'Hauteur totale de la barre (% de la hauteur de la diapo)
Const PositionX As Single = 0.1 'Position en X de la barre (% de la longueur de la diapo en partant de la gauche)
Const PositionY As Single = 0.05 'Position en Y de la barre (% de la hauteur de la diapo en partant de la gauche)
'Récupération des infos
Set Pres = ActivePresentation
H = Pres.PageSetup.SlideHeight
W = Pres.PageSetup.SlideWidth * Longueur
nb = Pres.Slides.Count
Counter = 1
'Pour chaque Slide
For X = 1 To Pres.Slides.Count
If X > 2 And X < (Pres.Slides.Count) Then
'Supprime l'ancienne barre de progression
nbShape = Pres.Slides(X).Shapes.Count
del = 0
For a = 1 To nbShape
If Left(Pres.Slides(X).Shapes.Item(a - del).Name, 2) = "PB" Then
Pres.Slides(X).Shapes.Item(a - del).Delete
del = del + 1
End If
Next
'pose la nouvelle barre de progression
For I = 0 To nb - 1
Set OBJ = Pres.Slides(X).Shapes.AddShape(msoShapeChevron, (W * I / (nb - 3)) + W / (nb - 3) * (PositionX / 2), H * (1 - PositionY), (W / (nb - 3)) * (1 - PositionX), H * Hauteur)
OBJ.Name = "PB" & I
OBJ.Line.Visible = msoFalse
If I + 1 = Counter Then
OBJ.Fill.ForeColor.RGB = RGB(156, 156, 156)
Else
OBJ.Fill.ForeColor.RGB = RGB(216, 32, 39)
End If
Next
Counter = Counter + 1
End If
Next X
End Sub
I am using vb.net.
I have a database set with following table and three columns. So user can add their event start date/time and end date/time.
Table = "Eventable"
|----|------------------------|-----------------------|
| ID | StartBy | EndBy |
|----|------------------------|-----------------------|
| 1 | 7/1/2015 2:30:00 PM | 7/1/2015 4:00:00 PM |
| 2 | 1/22/2013 8:00:00 AM | 1/22/2013 3:00:00 PM |
| 3 | 10/22/2014 10:25:00 AM | 10/22/2014 6:20:00 PM |
| 4 | 4/5/2010 5:00:00 PM | 4/5/2010 8:00:00 PM |
| 5 | 7/3/2015 12:00:00 PM | 77/2/2015 8:00:00 PM |
|----|------------------------|-----------------------|
The user will next enter a new StartBy Event from textbox(7/1/2015 3:00:00 PM):
Dim getNewStartEventDateTime As String = getNewStartEventDateTimeTB.Text
Then the user will enter a new EndBy Event from textbox(7/1/2015 7:00:00 PM):
Dim getNewEndEventDateTime As String = getNewEndEventDateTimeTB.Text
Now, how can I write a query that will test to see if the new event is not between the database timing? In other words, a test to see if the new event timing isn't taken.
This is what I have so far.
Dim query As String = "SELECT * FROM Eventable WHERE StartBy not Between #" & getNewStartEventDateTime.Text & "# AND #" & getNewEndEventDateTime.Text & ";"
If error then
// Error - This time is taken. Please enter a different time.
else
// No errors - Add a new event
end if
Try the below query:
SELECT * FROM Eventable
where EndBy < '"& getNewStartEventDateTime .Text &"'
or StartBy > '"& getNewEndEventDateTime & "'
Query using between :
SELECT * FROM Eventable WHERE StartBy not Between '" & getNewStartEventDateTime .Text & "' AND '" & getNewEndEventDateTime &"';
Try this way
Dim query As String = "SELECT * FROM Eventable WHERE StartBy not Between '" & getNewStartEventDateTime .Text & "' AND '" & getNewEndEventDateTime & "';"
I am new to VBA, I am getting this Error 13 - types mismtached but I have no idea why and I found nothing helpful...
any hint ? (Sorry it's in french)
Function EIDPA(Coût_actif, Tx_dépréciation, Tx_marginal, Coût_opportunité)
EIDPA = ((Coût_actif * Tx_dépréciation * Tx_marginal) / (Coût_opportunité + Tx_dépréciation)) * ((1 + (0.5 * Coût_opportunité)) / (1 + Coût_opportunité))
End Function
Sub EIDPA2()
Coût_actif = InputBox("Entrez le coût de l'actif SVP", "Calculateur", "100000")
Tx_dépréciation = InputBox("Entrez le taux de dépréciation pour ammortissement SVP", "Calculateur", "0.30")
Tx_marginal = InputBox("Entrez le taux marginal d'imposition SVP", "Calculateur", "0.50")
Coût_opportunité = InputBox("Entrez le coût d'opportunité applicable SVP", "Calculateur", "0.05")
MsgBox "La valeur actuelle des économies d'impôts est de: " _
& Module1.EIDPA(Coût_actif, Tx_dépréciation, Tx_marginal, Coût_opportunité) & "$", vbInformation, "Calculateur"
End Sub
You should be properly Dimming your variables; otherwise you're attempting to use string variables as numerics:
Function EIDPA(Coût_actif As Double, Tx_dépréciation As Double, Tx_marginal As Double, Coût_opportunité As Double) As Double
EIDPA = ((Coût_actif * Tx_dépréciation * Tx_marginal) / (Coût_opportunité + Tx_dépréciation)) * ((1 + (0.5 * Coût_opportunité)) / (1 + Coût_opportunité))
End Function
Sub EIDPA2()
Dim Coût_actif As Double
Dim Tx_dépréciation As Double
Dim Tx_marginal As Double
Dim Coût_opportunité As Double
Coût_actif = CDbl(InputBox("Entrez le coût de l'actif SVP", "Calculateur", "100000"))
Tx_dépréciation = CDbl(InputBox("Entrez le taux de dépréciation pour ammortissement SVP", "Calculateur", "0.30"))
Tx_marginal = CDbl(InputBox("Entrez le taux marginal d'imposition SVP", "Calculateur", "0.50"))
Coût_opportunité = CDbl(InputBox("Entrez le coût d'opportunité applicable SVP", "Calculateur", "0.05"))
MsgBox "La valeur actuelle des économies d'impôts est de: " _
& Module1.EIDPA(Coût_actif, Tx_dépréciation, Tx_marginal, Coût_opportunité) & "$", vbInformation, "Calculateur"
End Sub
You're getting an error because InputBox returns strings, and you're trying to multiply strings together here:
EIDPA = ((Coût_actif * Tx_dépréciation * Tx_marginal) / (Coût_opportunité + Tx_dépréciation)) * ((1 + (0.5 * Coût_opportunité)) / (1 + Coût_opportunité)).
Try declaring your French variables as integers/floating point to see if that helps. More info
I've implemented two functions in VBA
formatAddress()
gets an address (String) and returns an array of Strings, each of these has a section of street address. xample: [via] [n:civico][citta].. ecc
getPoint
it use the returned array of formatAddress() function for calculate geographics coordinates that will put on a courrent cells. the 2. calls the 1. every street address to calculate.
While script is running, every call of 2. the RAM used by MapPoint encrease like as exponential, until to freeze the script execution with 810MB RAM used, and return an error code as Tipical Microsoft style, generic error without documentation. "Si è verificato un errore generato dal sistema o da un componente esterno" "An error ocurred, it was generated by system or by an external component"
I looked for in to Microsoft references http://msdn.microsoft.com/en-us/library/aa723478
if exist a way to manage this error ( I guess that every call, the courrent calculus doesn't dischard of the memory ) without results.
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
the original code is plased on
https://docs.google.com/document/d/161srj6Zz0B2x_BHQV85QQft-JY55RK8oFwj3SLlUo9A/edit
I commented some code to show the function only while work and generate freeze
Thanks
On the road with only an iPad, so I can't see most of that code; but what you describe is known behavior with MapPoint's API. Basically the garbage collector is optimized for GUI users, and not programming usage. A simple garbage collection method would be a good solution, but one has not been implemented. Manually minimizing and maximizing MapPoint is a known workaround, but to do this programmatically you have to send Windows messages to the main MapPoint window (difficult in Win7/Vista) - the API minimize/maximize methods are insufficient.
If you are using MapPoint as an external application, then restarting it periodically is another solution - this is what my MPMileage product does.
The other important thing is to be very clean with your MapPoint object handling. Clean up, free objects, etc as rapidly as possible. The garbage collection that does occur will never reclaim an object whilst there is a reference to it, so set all references to 0 or NULL as soon as you have finished with them. This can make a big difference to MapPoint's memory growth, but for really big batch jobs it only delays the inevitable.
Example Data Link - Sorry, wouldn't format correctly when pasted.
1.
Dec 01, 2011
06:00:00 AM
Dec 01, 2011
07:05:00 AM
65
2.11
2.
Dec 01, 2011
06:00:00 PM
Dec 01, 2011
07:05:00 PM
65
2.11
3.
Dec 02, 2011
06:05:00 AM
Dec 02, 2011
07:05:00 AM
60
1.95
I'd like each separate line to have its own place in an array or datatable, but I can't seem to get it to work correctly. There must be something different with the ending characters?
Code is below:
Dim strOutput As String = ""
'' Demo Data
'Dim strData As String = "59. Dec 01, 2011 06:05:00 PM Dec 01, 2011 10:05:00 PM 240 80.00"
'strOutput = +FormatRow(strData)
'' Demo Data
Dim sFileName As String = OpenFileDialog.FileName
If My.Computer.FileSystem.FileExists(sFileName) Then
Dim srFileReader As System.IO.StreamReader
Dim sInputLine As String
srFileReader = System.IO.File.OpenText(sFileName)
sInputLine = srFileReader.ReadLine()
Do Until sInputLine Is Nothing
'strOutput = +FormatRow(sInputLine)
Dim title As String = srFileReader.ReadLine()
Dim startTime As DateTime = srFileReader.ReadLine() & " " & srFileReader.ReadLine()
Dim endTime As DateTime = srFileReader.ReadLine() & " " & srFileReader.ReadLine()
Dim timeSpan As TimeSpan = endTime.Subtract(startTime)
Dim minutesTotal As Integer = timeSpan.TotalMinutes
' Burn Minutes
srFileReader.ReadLine()
Dim billMinutes As Integer = minutesTotal
Dim billTotal As Double = srFileReader.ReadLine()
strOutput += ""
Loop
Output something like:
12/1/2011 6:00:00 AM 12/1/2011 7:05:00 AM 65 65 2.11
You have read while text file at once and I think File.ReadAllLines will be good choice.
Dim str
Dim fileName = "C:\SampleData.txt"
Dim lines() = File.ReadAllLines(fileName)
For i = 0 To lines.GetUpperBound(0) Step 7
str = String.Format("{0}{1}{2}{3}{4}{5}",
lines(i), lines(i + 1), lines(i + 2), lines(i + 3),
lines(i + 4), lines(i + 5))
Console.WriteLine(str)
Next