We help IT Professionals succeed at work.

multiuser with DAO

sal21
sal21 asked
on
390 Views
Last Modified: 2013-12-25
I have this code to update record...
(I use DAO bwcause have problem with ADO dll)...
Prob:
I distribute to 2 users the same application.
If the same user start the application one of this user have error when the code go to .update in INSERISCIANAGRAFICA.

Sub INSERISCIANAGRAFICA_ACCESS()

    TROVATO = 0
    RIGA = 0

    Set System = CreateObject("EXTRA.System")
    If (System Is Nothing) Then
        MsgBox "Impossibile creare l'oggetto di sistema EXTRA.L'esecuzione della macro è stata interrotta."
        Stop
    End If
    '-----SCELTA SESSIONE-----------------------------------------------

    NumberOfSessions = System.Sessions.Count
    For I = 1 To NumberOfSessions
        Set Sessions = System.Sessions.Item(I)
        Sessions.Activate
        FPROFILE$ = UCase(Sessions.FullName)
        If Right(FPROFILE$, 5) = "B.EDP" Then
            SessItem = I
            Exit For
        End If
    Next I

    '-------------------------------------------------------------------
    'Imposta il tempo di attesa predefinito
    G_HostSettleTime = 500      'millisecondi
    System.TimeoutValue = 12000

    OldSystemTimeout& = System.TimeoutValue
    If (G_HostSettleTime > OldSystemTimeout) Then
        System.TimeoutValue = G_HostSettleTime
    End If

    ' Legge l'oggetto richiesto della sessione
    Set Sess0 = System.Activesession

    If Not Sess0.Visible Then Sess0.Visible = True

    Set DB2 = DBEngine.OpenDatabase("\\CL259F4500\MAXTOR\APPLICAZIONI\APPELLATIVI.MDB")
    Set RSD2 = DB2.OpenRecordset("APP")
    'Set DB = DBEngine.OpenDatabase("\\CL259F4500\MAXTOR\APPLICAZIONI\COPE_NDG_4780.MDB")
    'Set RSD = DB.OpenRecordset("SICILIA_COPE_NDG")
    Set DB1 = DBEngine.OpenDatabase("\\GCD01F4500\DATI\PUBBLICA\APPLICAZIONI\ANAGRAFICA.mdb")
    Set RSD1 = DB1.OpenRecordset("ANAGRAFICA1")
    Set RSD3 = DB1.OpenRecordset("COPE_NON_TROVATO")
    RSD1.Index = "COPE"

    CONTA_RECORD = RSD3.RecordCount
    CONTA_RECORD1 = RSD1.RecordCount

    'RECORD TOTALI DA ELABORARE
    Text2.Text = Format((CONTA_RECORD), "#,##0")
    'RECORD TOTALI DA ELABORARE

RITORNO:

 With RSD3

        Do While Not RSD3.EOF

    COPE = RSD3.Fields("COPE")
    RSD1.Seek "=", COPE

    If RSD1.NoMatch Then
        TROVATO = TROVATO + 1
        Call INSERISCIANAGRAFICA(COPE)
    Else
        TROVATO = TROVATO + 1
DATA_AGGIORNAMENTO = Format(CDate(Now), "DD/MM/YYYY")
   RSD1.Seek "=", COPE
   If RSD1.NoMatch Then
   
    With RSD1
        RSD1.AddNew
       
        .Fields("COPE") = COPE
        .Fields("DATA AGGIORNAMENTO") = DATA_AGGIORNAMENTO
        .Update
       
    End With
        End If
        GoTo SALTARIGA1
    End If

SALTARIGA1:

    COPE = ""
    COPLIST = ""
    DESCR = ""
    NOMINATIVO = ""
    CCIAA = ""
    DT_NASCITA = ""
    LUOGO_NASCITA = ""
    PR_NASCITA = ""
    SESSO = ""
    RESIDENZA = ""
    CAP_RESIDENZA = ""
    LUOGO_RESIDENZA = ""
    PR_RESIDENZA = ""
    CF = ""
    DOMICILIO = ""
    CAP_DOMICILIO = ""
    LUOGO_DOMICILIO = ""
    PR_DOMICILIO = ""
    DOMICILIO_IDEM = ""
    DATA_CENSIMENTO = ""
    DIP_CENSIMENTO = ""
    NOTE_1 = ""
    NOTE_2 = ""
    DATA_AGGIORNAMENTO = ""
    ULT_AGG = ""
    AG_ULT_AGG = ""
    SETTORE = ""
    TEST_RECORD1 = ""
   
            RSD3.MoveNext

        Loop

    End With

FINE:

    RSD.Close
    Set RSD = Nothing
    DB.Close
    Set DB = Nothing
    RSD1.Close
    Set RSD1 = Nothing
    DB1.Close
    Set DB1 = Nothing
    RSD2.Close
    Set RSD2 = Nothing
    DB2.Close
    Set DB2 = Nothing
    RSD3.Close
    Set RSD3 = Nothing

    Unload Form1

End Sub
===================================
Sub INSERISCIANAGRAFICA(COPE)

    For TN = 1 To 150000
        If Sess0.Screen.GetString(8, 24, 4) = "COPE" Then
            GoTo OK:
        End If
        If Not Sess0.Screen.GetString(8, 24, 4) = "COPE" Then
            GoTo FINE
        End If

    Next TN

    If TN > 150000 Then
        Exit Sub
    End If

OK:

    Sess0.Screen.PUTSTRING "         ", 8, 35
    Sess0.Screen.PUTSTRING COPE, 8, 35
    Sess0.Screen.SendKeys ("<ENTER>")
   

    For TN = 1 To 50
    Next TN
   
    For J = 1 To 150000

        If Sess0.Screen.GetString(2, 2, 8) = "ANV00701" Then GoTo TROVATO
        If Sess0.Screen.GetString(23, 2, 19) = "COPE    INESISTENTE" Or Sess0.Screen.GetString(23, 2, 19) = "COPE    NON AMMESSO" Then

            DATA_AGGIORNAMENTO = Format(CDate(Now), "DD/MM/YYYY")
            RSD1.Seek "=", COPE
            If RSD1.NoMatch Then

                With RSD1
                    RSD1.AddNew
                    .Fields("COPE") = COPE
                    .Fields("DATA AGGIORNAMENTO") = DATA_AGGIORNAMENTO
                    .Update

                End With
            End If

            Sess0.Screen.SendKeys ("<CLEAR>")
            Sess0.Screen.WAITFORSTRING "        ", 2, 2
           
    For TN = 1 To 50
    Next TN
   
            If Not Sess0.Screen.GetString(2, 2, 8) = "        " Then
                Exit Sub
            End If
            Sess0.Screen.PUTSTRING "COMSEC 21.3", 1, 1
            Sess0.Screen.SendKeys ("<ENTER>")
           
    For TN = 1 To 50
    Next TN
   
            Sess0.Screen.WAITFORSTRING "ANV00700", 2, 2
            If Not Sess0.Screen.GetString(2, 2, 8) = "ANV00700" Then
                Exit Sub
            End If
            Call AVANTI_1
            Exit Sub
        End If

    Next J

    If J > 150000 Then
        Exit Sub
    End If

TROVATO:

    COPLIST = ""
    COPLIST = Sess0.Screen.GetString(4, 60, 10)
    COD_APP = ""
    COD_APP = Trim(Sess0.Screen.GetString(7, 60, 2))

    Call DAOOpenRecordset(COD_APP)

    NOMINATIVO = ""
    NOMINATIVO = Trim(Sess0.Screen.GetString(4, 2, 48) & Sess0.Screen.GetString(5, 2, 48))
    DATA_CENSIMENTO = ""
    DATA_CENSIMENTO = Sess0.Screen.GetString(19, 18, 8)
    DIP_CENSIMENTO = ""
    DIP_CENSIMENTO = Sess0.Screen.GetString(19, 36, 4)
    NOTE_1 = ""
    NOTE_1 = Trim(Sess0.Screen.GetString(20, 1, 80))
    NOTE_2 = ""
    NOTE_2 = Trim(Sess0.Screen.GetString(21, 1, 80))
    ULT_AGG = ""
    ULT_AGG = Trim(Sess0.Screen.GetString(19, 62, 8))
    ULT_AGG = Format(ULT_AGG, "DD/MM/YYYY")
    AG_ULT_AGG = ""
    AG_ULT_AGG = Trim(Sess0.Screen.GetString(19, 76, 4))

    If Not (Sess0.Screen.GetString(8, 2, 5) = "CCIAA" Or Sess0.Screen.GetString(9, 2, 6) = "NATO/A") Then MsgBox ("stop")

    If Sess0.Screen.GetString(8, 2, 5) = "CCIAA" Then

        'AGGIORNA PERSONA GIURIDICA-------------------------------

        If Not Trim(Sess0.Screen.GetString(8, 16, 8)) = "" Then
            CCIAA = Trim(Sess0.Screen.GetString(8, 16, 8)) & " - " & Sess0.Screen.GetString(8, 31, 8) & " - " & Trim(Sess0.Screen.GetString(8, 43, 4))
        End If
        INDIRIZZO = ""
        INDIRIZZO = Trim(Sess0.Screen.GetString(10, 11, 32) & Sess0.Screen.GetString(11, 11, 29) & Sess0.Screen.GetString(12, 11, 29))
        For C = Len(INDIRIZZO) - 4 To 1 Step -1
            If IsNumeric(Mid(INDIRIZZO, C, 5)) = True And IsNumeric(Mid(INDIRIZZO, C + 4, 1)) = True Then Exit For
        Next C

        If Len(INDIRIZZO) < 5 Or C = 0 Or (Len(INDIRIZZO) - C - 4) > 40 Then GoTo SALTAINDIRIZZOPG

        RESIDENZA = ""
        RESIDENZA = Trim(Mid(INDIRIZZO, 1, C - 1))
        CAP_RESIDENZA = ""
        CAP_RESIDENZA = Mid(INDIRIZZO, C, 5)
        LUOGO_RESIDENZA = ""
        LUOGO_RESIDENZA = Trim(Mid(INDIRIZZO, C + 5, Len(INDIRIZZO) - C - 4))
        If Len(Trim(Sess0.Screen.GetString(11, 40, 2) & Sess0.Screen.GetString(12, 40, 2))) = 2 Then
            PR_RESIDENZA = ""
            PR_RESIDENZA = Trim(Sess0.Screen.GetString(11, 40, 2) & Sess0.Screen.GetString(12, 40, 2))
        End If

SALTAINDIRIZZOPG:

        CF = ""
        CF = Trim(Sess0.Screen.GetString(13, 64, 16))

    Else

        'AGGIORNA PERSONA FISICA----------------------------------
        If Not Trim(Sess0.Screen.GetString(9, 13, 10)) = "" Then
            DT_NASCITA = ""
            DT_NASCITA = Sess0.Screen.GetString(9, 13, 10)
        End If

        LUOGO_NASCITA = ""
        LUOGO_NASCITA = Trim(Sess0.Screen.GetString(9, 26, 22))
        PR_NASCITA = ""
        PR_NASCITA = Right(Trim(Sess0.Screen.GetString(9, 55, 4)), 2)
        If Sess0.Screen.GetString(9, 61, 5) = "SESSO" Then SESSO = Sess0.Screen.GetString(9, 68, 1)
        INDIRIZZO = ""
        INDIRIZZO = Trim(Sess0.Screen.GetString(11, 11, 32) & Sess0.Screen.GetString(12, 11, 29) & Sess0.Screen.GetString(13, 11, 29))

        For C = Len(INDIRIZZO) - 4 To 1 Step -1
            If IsNumeric(Mid(INDIRIZZO, C, 5)) = True And IsNumeric(Mid(INDIRIZZO, C + 4, 1)) = True Then Exit For
        Next C

        If Len(INDIRIZZO) < 5 Or C = 0 Or (Len(INDIRIZZO) - C - 4) > 40 Then GoTo SALTAINDIRIZZOPF
        RESIDENZA = ""
        RESIDENZA = Trim(Mid(INDIRIZZO, 1, C - 1))
        CAP_RESIDENZA = ""
        CAP_RESIDENZA = Mid(INDIRIZZO, C, 5)
        LUOGO_RESIDENZA = ""
        LUOGO_RESIDENZA = Trim(Mid(INDIRIZZO, C + 5, Len(INDIRIZZO) - C - 4))

        If Len(Trim(Sess0.Screen.GetString(12, 40, 2) & Sess0.Screen.GetString(13, 40, 2))) = 2 Then
            PR_RESIDENZA = ""
            PR_RESIDENZA = Trim(Sess0.Screen.GetString(12, 40, 2) & Sess0.Screen.GetString(13, 40, 2))
        End If

SALTAINDIRIZZOPF:

        CF = ""
        CF = Trim(Sess0.Screen.GetString(13, 64, 16))

    End If

    Sess0.Screen.PUTSTRING "21.4", 22, 8
    Sess0.Screen.SendKeys ("<ENTER>")

    For TN = 1 To 50
    Next TN
   
    Sess0.Screen.WAITFORSTRING "COPLIST", 4, 53, 7

    For TN = 1 To 150000
        If Sess0.Screen.GetString(5, 53, 4) = "COPE" Then
            GoTo VAI
        End If
        If Sess0.Screen.GetString(3, 2, 4) = "COPE" Then
            Sess0.Screen.PUTSTRING "21.4", 22, 8
            Sess0.Screen.SendKeys ("<ENTER>")
           
           
    For NT = 1 To 50
    Next NT
   
            Sess0.Screen.WAITFORSTRING "ANV00700", 2, 2

            Sess0.Screen.PUTSTRING "21.4", 22, 8
            Sess0.Screen.SendKeys ("<ENTER>")
           
           
    For NT = 1 To 50
    Next NT
           
            Sess0.Screen.WAITFORSTRING "COPLIST", 4, 53, 7
            GoTo VAI
        End If
    Next TN

    If TN > 150000 Then
        Exit Sub
    End If

VAI:

    For TN = 1 To 50
    Next TN

    'VAI1:

    Sess0.Screen.WAITFORSTRING "COPLIST", 4, 53, 7

    SETTORE = ""
    SETTORE = Sess0.Screen.GetString(11, 20, 2)

    DOMICILIO = ""
    DOMICILIO = Trim(Sess0.Screen.GetString(10, 48, 32) & Sess0.Screen.GetString(11, 48, 29) & Sess0.Screen.GetString(12, 48, 29))
    For C = Len(DOMICILIO) - 4 To 1 Step -1
        If IsNumeric(Mid(DOMICILIO, C, 5)) = True And IsNumeric(Mid(DOMICILIO, C + 4, 1)) = True Then Exit For
    Next C
    If Len(DOMICILIO) < 5 Or C = 0 Or (Len(DOMICILIO) - C - 4) > 40 Then GoTo SALTADOMICILIO
    DOMICILIO = Trim(Mid(DOMICILIO, 1, C - 1))
    CAP_DOMICILIO = ""
    CAP_DOMICILIO = Trim(Sess0.Screen.GetString(12, 48, 5))
    LUOGO_DOMICILIO = ""
    LUOGO_DOMICILIO = Trim(Sess0.Screen.GetString(12, 55, 20))

    If Len(Trim(Sess0.Screen.GetString(11, 77, 2) & Sess0.Screen.GetString(12, 77, 2))) = 2 Then
        PR_DOMICILIO = ""
        PR_DOMICILIO = Trim(Sess0.Screen.GetString(11, 77, 2) & Sess0.Screen.GetString(12, 77, 2))
    End If

    DOMICILIO_IDEM = ""
    DOMICILIO_IDEM = Sess0.Screen.GetString(9, 58, 6)

    If SETTORE = "" Then
        MsgBox ("SETTORE VUOTO")
    End If

SALTADOMICILIO:

    DATA_AGGIORNAMENTO = Format(CDate(Now), "DD/MM/YYYY")

    With RSD1

        RSD1.AddNew

        .Fields("COPE") = COPE
        .Fields("COPLIST") = COPLIST
        '.Fields("NDG") = Format(RSD.Fields("NDG"), "#000000000")
        .Fields("APPELLATIVO") = DESCR
        .Fields("NOMINATIVO") = Replace((NOMINATIVO), ",", " E")
        .Fields("CCIAA") = CCIAA

        If Not DT_NASCITA = "" Then
            .Fields("DT NASCITA") = DT_NASCITA
        End If

        .Fields("LUOGO NASCITA") = LUOGO_NASCITA
        .Fields("PR NASCITA") = PR_NASCITA
        .Fields("SESSO") = SESSO
        .Fields("RESIDENZA") = RESIDENZA
        .Fields("CAP RESIDENZA") = CAP_RESIDENZA
        .Fields("LUOGO RESIDENZA") = LUOGO_RESIDENZA
        .Fields("PR RESIDENZA") = PR_RESIDENZA
        .Fields("CF") = CF
        .Fields("DOMICILIO") = DOMICILIO
        .Fields("CAP DOMICILIO") = CAP_DOMICILIO
        .Fields("LUOGO DOMICILIO") = LUOGO_DOMICILIO
        .Fields("PR DOMICILIO") = PR_DOMICILIO
        .Fields("DOMICILIO IDEM") = DOMICILIO_IDEM
        .Fields("DATA CENSIMENTO") = DATA_CENSIMENTO
        .Fields("DIP CENSIMENTO") = DIP_CENSIMENTO
        .Fields("NOTE - 1") = NOTE_1
        .Fields("NOTE - 2") = NOTE_2
        .Fields("DATA AGGIORNAMENTO") = DATA_AGGIORNAMENTO

        If Not ULT_AGG = "" Then
            .Fields("ULT AGG") = ULT_AGG
        End If

        .Fields("AG ULT AGG") = AG_ULT_AGG

        If SETTORE = "" Then
            MsgBox ("SETTORE VUOTO")
        End If

        .Fields("SETTORE") = SETTORE
        '.Fields("PROVA27") = Range("AA" & R).Value
        '.Fields("PROVA28") = Range("AB" & R).Value
        '.Fields("PROVA29") = Range("AC" & R).Value
        '.Fields("PROVA30") = Range("AD" & R).Value
        .Update
        'KK = KK + 1
        RIGA = RIGA + 1
        CONTA_RECORD1 = CONTA_RECORD1 + 1

    End With

    DoEvents

    Text1.Text = Format((RIGA), "#,##0")
    'Text3.Text = Format((CONTA_RECORD - RIGA), "#,##0")

    Call AVANTI_1

FINE:

End Sub
Comment
Watch Question

IT Director
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.