Hallo,
bis jetzt hat dieser Agent immer funktioniert. Nehm ich die gleiche csv mit 15.000 Zeilen liest der Agent alles ein. 116000 scheint zu viel zu sein?
Sub Initialize
On Error Goto err_ImportExcel
Dim tmpFic As Variant
Dim sFic As String
Dim xlsApp As Variant
Dim xlsWorkBook As Variant
Dim xlsSheet As Variant
Dim xlsLigne As Integer
Dim xlsColonne As Integer
tmpFic = OuvreXLS()
sFic = tmpFic(0)
Dim sLig() As String
Dim sCol() As String
Dim iCompteur As Integer
Dim iCompteurLigne As Integer
Dim iCompteurColonne As Integer
Dim vVF As Variant
Print "Connexion à Excel..."
Set xlsApp = CreateObject("Excel.Application")
Print "Ouverture du fichier : " & sFic
xlsApp.Workbooks.Open sFic
Set xlsWorkBook = xlsApp.ActiveWorkbook
Set xlsSheet = xlsWorkBook.ActiveSheet
xlsApp.Visible = False
xlsSheet.Cells.SpecialCells(11).Activate
xlsLigne = xlsApp.ActiveWindow.ActiveCell.Row
xlsColonne = xlsApp.ActiveWindow.ActiveCell.Column
xlsSheet.Cells(1, 1).Select
For iCompteurColonne = 1 To xlsColonne
If iCompteurColonne = 1 Then
Redim sCol(iCompteurColonne) As String
sCol(iCompteurColonne) = xlsSheet.Cells(1, iCompteurColonne).Value
Else
Redim Preserve sCol(iCompteurColonne) As String
sCol(iCompteurColonne) = xlsSheet.Cells(1, iCompteurColonne).Value
End If
Next
For iCompteurLigne = 2 To xlsLigne
xlsSheet.Cells(iCompteurLigne, 1).select
For iCompteurColonne = 1 To xlsColonne
If iCompteurColonne = 1 Then
Redim sLig(iCompteurColonne) As String
sLig(iCompteurColonne) = xlsSheet.Cells(iCompteurLigne, iCompteurColonne).Value
Else
Redim Preserve sLig(iCompteurColonne) As String
sLig(iCompteurColonne) = xlsSheet.Cells(iCompteurLigne, iCompteurColonne).Value
End If
Next
vVF = False
For iCompteur = 1 To Ubound(sLig)
If sLig(iCompteur) <> "" Then
vVF = True
Exit For
Else
vVF = False
End If
Next
Print "Traitement de la ligne " & iCompteurLigne & " sur " & xlsLigne
If vVF = True Then
Call CreationDocument(sLig, xlsColonne, sCol())
End If
Next
Print "Déconnexion d'Excel..."
xlsWorkBook.Close False
xlsApp.Quit
Set xlsApp = Nothing
Print "Fin de l'importation du fichier Excel"
Exit Sub
err_ImportExcel:
Resume Next
End Sub