Code: Select all
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim glb_origCalculationMode As Integer, Y As Long, MEZZO_OP As String, DESCR_MEZZO_OP As String
Dim NOME_TROVATO As String, NR_MEZZO_FORTE As String
Dim TIPO_M_FORTE As String, DESCR_MEZZO As String, RST2 As ADODB.Recordset
Dim MATRICOLA As String, DIREZ As String, ORA_OP As String
Dim FS As FileSystemObject, CONTA As Long, CONN As ADODB.Connection, RST As ADODB.Recordset
Dim TS As TextStream, TEST As String, ORDINE As String, OPERAZIONE As String, RST1 As ADODB.Recordset
Dim COD_MNE As String, DESCR_COD_MNE As String, CONTAB As String, SQL As String, ORA_OPERAZ As String
Dim DATA_OP As Date, SPORT As String, DESCR_SPORT As String, MATR As String, DATA_ESEC As Date
Dim PRESENTATORE As String, RUOLO As String, NDG As String, TIP_MEZZO As String, NR_MEZZO As String
Dim P1 As Long, INTROITATI As Double, EROGATI As Double, SPORT_CC As String, CC As String
Dim P2 As Long, TEST_CONTANTE As String, CONTANTE As Double, RESTO As Double, TOT_AC As Double
Dim STRRETURN As String, NRAC As Long, strDBRows(), strDBRows1(), PS1 As Long, PS2 As Long, EROG As Long, INTRO As Long
Private Sub ListFiles(strPath As String, Optional Extention As String)
Dim FILE As String, Found_INDEX As Range
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
If Trim$(Extention) = "" Then
Extention = "*.*"
ElseIf Left$(Extention, 2) <> "*." Then
Extention = "*." & Extention
End If
FILE = Dir$(strPath & Extention)
Do While Len(FILE)
Set Found_INDEX = Sheets("foglio2").Columns("B:B").Find(what:=FILE, lookat:=xlWhole)
If Found_INDEX Is Nothing Then
LEGGI (FILE)
End If
FILE = Dir$
Loop
End Sub
Sub LOOP_FILE_PARTENZA_CASSA()
On Error GoTo ResetSpeed
'SpeedOn
Set CONN = New ADODB.Connection
CONN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\REPORT_L0928\DATABASE\CASSA-L0928_TEST.mdb;Persist Security Info=False"
CONN.CursorLocation = adUseServer
CONN.Open
CONN.Properties("Jet OLEDB:Max Locks Per File") = 1000000
SQL = "SELECT TIPO, DESCRIZIONE FROM MEZZI_FORTI"
Set RST = CONN.Execute(SQL)
Erase strDBRows1()
strDBRows1 = RST.GetRows()
RST.Close
Set RST = Nothing
Set RST = New ADODB.Recordset
RST.Open "MOV_CASSA", CONN, 3, 3
ListFiles "C:\REPORT_L0928\", "txt"
CONN.Close
Set CONN = Nothing
Set RST = Nothing
ResetSpeed:
'SpeedOff
End Sub
Sub LEGGI(FILE)
Dim TEST_MATR As String, SQL As String
Dim FileID As Integer
Dim TEST_DATE As Date
On Error GoTo Err_SomeName
CONTA = 0
EROG = Empty
INTRO = Empty
TEST_DATE = Mid$(FILE, 7, 10)
'PULISCO LA TABELLA PER DATA CONTABILE - SE GIA' ESITONO DATI
'CONN.BeginTrans
SQL = "DELETE FROM MOV_CASSA WHERE DATA_OPERAZIONE=#" & Format$(TEST_DATE, "MM/DD/YYYY") & "#"
CONN.Execute SQL, , adCmdText + adExecuteNoRecords
'CONN.CommitTrans
'PULISCO LA TABELLA PER DATA CONTABILE - SE GIA' ESITONO DATI
'CONN.BeginTrans
FileID = FreeFile
Open "C:\REPORT_L0928\" & FILE For Input As #FileID
Do Until EOF(FileID)
Line Input #FileID, TEST
If Len(Trim$(TEST)) > 0 Then
If Mid$(TEST, 1, 43) = "FOGLIO DI FONDO OPERAZIONI DI SPORTELLO DEL" Then
DATA_OP = Trim$(Mid$(TEST, 45, 10))
End If
If Mid$(TEST, 1, 18) = "NUMERO OPERAZIONE:" Then
OPERAZIONE = Trim$(Mid$(TEST, 20, 17))
If InStr(TEST, "IDENTIFICATIVO MEZZO OPERANTE: TIPO:") > 0 Then
MEZZO_OP = ""
DESCR_MEZZO_OP = ""
NR_MEZZO = ""
PS1 = Empty
PS2 = Empty
STRRETURN = ""
' CERCO LA POSIZIONE DI IDENTIFICATIVO MEZZO OPERANTE: TIPO:
PS1 = InStr(TEST, "IDENTIFICATIVO MEZZO OPERANTE: TIPO:")
' CERCO LA POSIZIONE DI NUMERO:
PS2 = InStr(PS1 + 36, TEST, "NUMERO:")
' ESTRAGGO VALORE
STRRETURN = Mid$(TEST, PS1 + 36, PS2 - PS1 - 36)
' Trim LA STRINGA TROVATA
MEZZO_OP = Trim$(STRRETURN)
NR_MEZZO = Trim$(Mid$(TEST, 92, 6))
If MEZZO_OP = "" Or MEZZO_OP = "0" Then
MEZZO_OP = "0"
End If
If NR_MEZZO = "" Or NR_MEZZO = "0" Then
NR_MEZZO = "0"
End If
'RICERCA MEZZO
If MEZZO_OP <> "" Then
For Y = 0 To UBound(strDBRows1, 2)
If CDbl(MEZZO_OP) = strDBRows1(0, Y) Then
DESCR_MEZZO_OP = strDBRows1(1, Y)
Exit For
End If
Next Y
End If
If Y > UBound(strDBRows1, 2) Then
Debug.Print OPERAZIONE & " - " & DATA_OP
Stop
End If
'RICERCA MEZZO
End If
End If
' INTROITATI '
If Mid$(TEST, 49, 33) = "INTROITATI DAL MEZZO DI CUSTODIA:" Then
INTROITATI = Trim$(Mid$(TEST, 25, 20))
End If
' INTROITATI '
' EROGATI '
If Mid$(TEST, 49, 30) = "EROGATI DAL MEZZO DI CUSTODIA:" Then
EROGATI = Trim$(Mid$(TEST, 25, 20))
End If
' EROGATI '
End If
If Mid$(TEST, 1, 37) = "---------- OPERAZIONE ANNULLATA DALLA" Then
OPERAZIONE = ""
COD_MNE = ""
DESCR_COD_MNE = ""
CONTANTE = Empty
EROGATI = Empty
INTROITATI = Empty
ORA_OP = Empty
'CONTA = CONTA - 1
If EROGATI > 0 Then
EROG = EROG - 1
End If
If INTROITATI > 0 Then
INTRO = INTRO - 1
End If
End If
If Mid$(TEST, 1, 30) = "---------- OPERAZIONE ESEGUITA" And (EROGATI > 0 Or INTROITATI > 0) Then
ORA_OP = Trim$(Mid$(TEST, 44, 5))
RST.AddNew
RST.Fields("OPERAZIONE").Value = OPERAZIONE
RST.Fields("DATA_OPERAZIONE").Value = DATA_OP
'RST.Fields("DATA_ESECUZIONE").Value = DATA_ESEC
RST.Fields("NR").Value = CDbl(MEZZO_OP)
RST.Fields("MEZZO_OP").Value = NR_MEZZO
RST.Fields("DESCR_MEZZO_OP").Value = DESCR_MEZZO_OP
RST.Fields("EROGATI").Value = EROGATI
RST.Fields("INTROITATI").Value = INTROITATI
'RST.Fields("ORA_OP").Value = ORA_OP
RST.Update
If EROGATI > 0 Then
EROG = EROG + 1
End If
If INTROITATI > 0 Then
INTRO = INTRO + 1
End If
OPERAZIONE = ""
COD_MNE = ""
DESCR_COD_MNE = ""
EROGATI = Empty
INTROITATI = Empty
ORA_OP = Empty
CONTA = CONTA + 1
'If CONTA Mod 5000 = 0 Then
' Sleep (1000)
'End If
End If
If Mid$(TEST, 1, 34) = "---------- CHIUSURA ORDINE NUMERO:" Then
ORDINE = ""
MEZZO_OP = ""
NR_MEZZO = ""
DESCR_MEZZO_OP = ""
End If
Loop
Close #FileID
'CONN.CommitTrans
NRAC = Sheets("foglio2").Cells(Sheets("foglio2").Rows.Count, "B").End(xlUp).Row + 1
Sheets("foglio2").Range("B" & NRAC).Value = FILE
Sheets("foglio2").Range("C" & NRAC).Value = EROG
Sheets("foglio2").Range("D" & NRAC).Value = INTRO
Sheets("foglio2").Range("E" & NRAC).Value = CONTA
Sheets("foglio2").Range("F" & NRAC).Value = (EROG + INTRO) - CONTA
Exit_SomeName:
Exit Sub
Err_SomeName:
MsgBox Err.Number & Err.Description
Resume Exit_SomeName
End Sub
Help!!!!!!!!!!!!!!!!!!!!!!!!!11
