Condivisione db access in rete lan

[devil946]

Salve a tutti, sono veramente incasinato. Ho cercato, ma invano, la soluzione al mio problema; in pratica io voglio condividere un db access 2013 inserito all'interno di una cartella condivisa in rete lan, autorizzazioni everyone full control. Ho rpvato sia con il metodo di divisione del db cioè creando il file .be e poi le copi del db, sia con il metodo del db originale e dei db con le tabelle collegate.
Il problema è il seguente:
CARTELLA CONDIVISA SU PC1, al suo interno pippo_be.mdb e pippo.mdb
SU PC2 collegamento sul desktop a pippo.mdb che si trova in cartella condivisa su PC1
Su PC1 nessun problema, su PC2 il problema si presenta quanto devo eseguire un codice tipo il seguente :

Private rsA As DAO.Recordset
Private Sub ReBuildRS()
If Not rsA Is Nothing Then rsA.Close: Set rsA = Nothing
Set rsA = CurrentDb.OpenRecordset("SELECT * FROM T_Appuntamenti " & _
"WHERE FIX([DataAppuntamento]) Between " & _
Format(DATADA, "\#yyyy\-mm\-dd\#") & " AND " & Format(DATAAL, "\#yyyy\-mm\-dd\#"))
End Sub

L'errore è nel CurrentDb, come faccio a venirne fuori?

Grazie a tutti

[optime]

quale errore?

[devil946]

Grazie ma ho risolto da solo mi ero confuso, sai con il troppo lavoro il cervello fonde

[optime]

dicci come hai risolto, magari serve a qualche altro forumista

[devil946]

Giusto vero mi ero scordato:

Dim RsCodice As DAO.Recordset
Dim Percorso As String
Dim dbs As DAO.Database


Percorso = CurrentDb.Name

Set dbs = OpenDatabase(Percorso, False)
Set RsCodice = dbs.OpenRecordset(....)
In pratica ho inserito in una variabile stringa il percorso di rete dove risiede il db, quindi ovunque questo si trovi viene smpre recuperato in maniera ottimale.
Ma adesso mi trovo di fronte ad un'altro scoglio e cioè riuscire ad aggiornare i dati su entrambe le postazioni in tempo reale.
Vi spiego ho 2 pc, PC1 e PC2, su PC1 c'è una cartella condivisa in rete con tutti i permessi, in questa cartella c'è il db con tutte le tabelle e i dati e anche le copie con le tabelle collegate per il PC1 locale e per il PC2 remoto(sempre nella lan). Apro la copia del db per il local e faccio delle modifiche alla agenda degli appuntamenti, finito le modifiche appaiono immediatamente a monitor sul PC1 da dove sto lavorando, ma sul PC2 non si vedono, finche non esco dal form dell'agenda degli appuntamenti e ci rientro. Io vorrei che al momento del refresh del form in locale avvenisse anche in remoto, se posto il codice qualcuno mi aiuta?
Grazie

[nman]

....... , se posto il codice qualcuno mi aiuta? ......

a me sembra tutto un pò strano
prova a postare il codice che ci incuriosisce

pero in un nuovo Thread nella sezione Windows e Software ( leggi il regolamento )


Facci sapere

[devil946]

Appena aperta la form eseguo questa sub
Private Sub ReBuildRS()
Dim Percorso As String
Dim dbs As DAO.Database


Percorso = CurrentDb.Name
Set dbs = OpenDatabase(Percorso, False)
If Not rsA Is Nothing Then rsA.Close: Set rsA = Nothing
Set rsA = dbs.OpenRecordset("SELECT * FROM T_Appuntamenti " & _
"WHERE FIX([DataAppuntamento]) Between " & _
Format(DATADA, "\#yyyy\-mm\-dd\#") & " AND " & Format(DATAAL, "\#yyyy\-mm\-dd\#"))

[devil946]

ops troppp tardi scusate

[devil946]

Però secondo me il problema sta in access e quindi potrebbe stare anche qui

[devil946]

Poi chiama questa sub Call RefreshDay
Private Sub RefreshDay()
' Questa Routine rigenera tutte le ListBox dei 6 giorni visualizzati
Dim x As Integer
Me.Painting = False
For x = 0 To 6
With Me.Controls("lst" & CStr(x))
' Sarebbe inutile questo controllo, ma lo ritengo ugualmente da fare
' quindi se la ListBox ha una Label Associata, e nel nostro caso è proprio
' quella che indica il Giorno la ricalcolo
If .Controls(0).ControlType = acLabel Then
.Controls(0).Caption = StrConv(Format(DateAdd("d", x, DATADA), "dddd, d mmmm yyyy"), vbProperCase)
End If
' quindi ripristino il ToolTip della ListBox
.ControlTipText = .Controls(0).Caption
' Il TAG lo userò in seguito e lo formatto in modo opportuno
.Tag = Format(DateAdd("d", x, DATADA), "\#yyyy\-mm\-dd\#")
' per ogni ListBox ora devo inserire gli ITEMS del singolo giorno.
FillItems Me.Controls("lst" & CStr(x))
End With
Next
Me.Painting = True
End Sub

POI questa
Private Sub FillItems(mList As Access.ListBox)
Dim intDelta_mat As Integer
Dim intDelta_sera As Integer
Dim intDelta_pause As Integer
Dim intDelta_sabato As Integer
Dim intDelta As Integer
Dim x As Integer
Dim y As Integer
Dim k As Integer

Dim TAG_Data As String ' Data(dd/mm/yy) recuperata dalla TAG del CTL(ListBox)
Dim PK_Data As String ' Data da assegnare alla PK e Column(0)
Dim PK_Ora As String ' Ora da assegnare alla Column(1)
Dim strObj As String ' Oggetto da assegnare alla Column(2)
Dim PK_Data_mat As String ' Data da assegnare alla PK e Column(0)
Dim PK_Ora_mat As String ' Ora da assegnare alla Column(1)
Dim strObj_mat As String ' Oggetto da assegnare alla Column(2)
Dim PK_Data_sera As String ' Data da assegnare alla PK e Column(0)
Dim PK_Ora_sera As String ' Ora da assegnare alla Column(1)
Dim strObj_sera As String ' Oggetto da assegnare alla Column(2)
Dim PK_Data_pause As String ' Data da assegnare alla PK e Column(0)
Dim PK_Ora_pause As String ' Ora da assegnare alla Column(1)
Dim strObj_pause As String ' Oggetto da assegnare alla Column(2)
Dim PK_Data_sabato As String ' Data da assegnare alla PK e Column(0)
Dim PK_Ora_sabato As String ' Ora da assegnare alla Column(1)
Dim strObj_sabato As String ' Oggetto da assegnare alla Column(2)



Dim strFilt As String ' Filtro per la ricerca del Record
Dim strFilt_mat As String ' Filtro per la ricerca del Record
Dim strFilt_sera As String ' Filtro per la ricerca del Record
Dim strFilt_pause As String ' Filtro per la ricerca del Record
Dim strFilt_sabato As String ' Filtro per la ricerca del Record
Dim itemSel As Integer ' Memorizzo ListIndex prima di resettare
Dim itemSel_mat As Integer ' Memorizzo ListIndex prima di resettare
Dim itemSel_sera As Integer ' Memorizzo ListIndex prima di resettare
Dim itemSel_pause As Integer ' Memorizzo ListIndex prima di resettare
Dim itemSel_sabato As Integer ' Memorizzo ListIndex prima di resettare
Dim ctlTAG As Date ' TAG di confronto per la data odierna(BackColor)

' Calcolo le ore a disposizione per gli appuntamenti
' ad esempio dalle 09:00 alle 20:00 e li converto in Minuti
' quindi divido per l'intervallo assegnato tra un appuntamento
' ed il successivo per ricavare quanti appuuntamenti devo
' prevedere ovvero quanti ITEMS

intDelta = DateDiff("n", START_TIME, STOP_TIME) / DELTA_TIME
intDelta_mat = DateDiff("n", START_TIME_MATTINA, STOP_TIME_MATTINA) / DELTA_TIME
intDelta_sera = DateDiff("n", START_TIME_SERA, STOP_TIME_SERA) / DELTA_TIME
intDelta_pause = DateDiff("n", START_TIME_PAUSE, STOP_TIME_PAUSE) / DELTA_TIME
intDelta_sabato = DateDiff("n", START_TIME_SABATO, STOP_TIME_SABATO) / DELTA_TIME

' Memorizzo l'ITEM selezionato per ripristinarlo
' dopo aver ripopolato il controllo, nel caso fosse=-1 va bene ugualmente

itemSel = mList.ListIndex
itemSel_mat = mList.ListIndex
itemSel_pause = mList.ListIndex
itemSel_sera = mList.ListIndex
itemSel_sabato = mList.ListIndex

' Resetto l'Origine ed anche il controllo, altrimenti rimarrebbe
' memorizzato l'Item selezionato anche dei giorni non Attivi.
mList.RowSource = vbNullString
mList = Null

TAG_Data = mList.Tag
' Questa parte gestisce il colore di sfondo(BackColor) della ListBox
' in base alla data precedente o successiva la data Odierna.
' QUESTO CODICE PER COLORARE DI ROSSO I GIORNI FESTIVI DA CALENDARIO
ctlTAG = CDate(Replace(mList.Tag, "#", vbNullString))

Dim giorno As String
giorno = Left(ctlTAG, 5)

If Weekday(ctlTAG) = vbSunday Then
' DOMENICA
mList.BackColor = vbRed
mList.ForeColor = vbWhite
ElseIf ctlTAG = Fix(Now()) Then
' DATA ODIERNA
mList.BackColor = cBK_NOW
mList.ForeColor = vbBlack
ElseIf giorno = "06/01" Or giorno = "25/04" Or giorno = "01/05" Or giorno = "02/06" Or giorno = "03/07" Or giorno = "01/11" Or giorno = "08/12" Or giorno = "25/12" Or giorno = "26/12" Or giorno = "01/01" Then
' DATA ODIERNA FESTIVA DA CALENDARIO COLORO IL GIORNO COME DOMENICA
mList.BackColor = vbRed
mList.ForeColor = vbWhite
ElseIf ctlTAG > Fix(Now()) Then
' DATA SUCCESSIVA
mList.BackColor = cBK_NEXT
mList.ForeColor = cBK_PREV
Else
' DATA PRECEDENTE
mList.BackColor = cBK_PREV
mList.ForeColor = cBK_NEXT
End If

Dim DeltaPausa As Integer
Dim DeltaLavoro As Integer
Dim q As Integer
Dim h As Integer
Dim Oggetto As String

'----------------- CODICE PER GIORNI FERIALI------------------------------
If Weekday(ctlTAG) <> vbSaturday Then

For x = 0 To intDelta_mat

' ricavo l'ora per la Colonna(1) Visibile e la data completa
' da assegnare alla Colonna(0) non visibile ma che rappresenta la PK del Recordset
'PK_Ora = Format$(DateAdd("n", x * DELTA_TIME, START_TIME), "h:mm")
'PK_Data = TAG_Data
'strObj = ";-"
PK_Ora_mat = Format$(DateAdd("n", x * DELTA_TIME, START_TIME_MATTINA), "h:mm")
PK_Data_mat = TAG_Data
strObj_mat = ";-"
' Cerco nel RS un'eventuale Record con la Data/Ora attuale per
' recuperarne i dati come Oggetto e Stato
If Not (rsA.BOF And rsA.EOF) Then
strFilt_mat = "[DataAppuntamento] = " & PK_Data_mat & " AND " & _
"[OraAppuntamento]= #" & PK_Ora_mat & "#"
'strFilt = "[DataAppuntamento] = " & PK_Data & " AND " & _
"[OraAppuntamento]= #" & PK_Ora & "#"
rsA.MoveFirst
rsA.FindFirst strFilt_mat
'rsA.FindFirst strFilt
If Not rsA.NoMatch Then
strObj_mat = ";" & rsA!Oggetto & ";" & rsA!Stato
'strObj = ";" & rsA!Oggetto & ";" & rsA!Stato
End If
End If
mList.AddItem PK_Data_mat & ";" & PK_Ora_mat & strObj_mat
'mList.AddItem PK_Data & ";" & PK_Ora & strObj
Next

' Ripristino l'Item Selezionato prima della ricompilazione
mList.Selected(itemSel_mat) = True
'mList.Selected(itemSel) = True


' Effettuiamo un ciclo PER LA PAUSA
For y = 0 To intDelta_pause
PK_Ora_pause = Format$(DateAdd("n", y * DELTA_TIME, START_TIME_PAUSE), "h:mm")
PK_Data_pause = TAG_Data
strObj_pause = "PAUSA"
If Not (rsA.BOF And rsA.EOF) Then
strFilt_pause = "[DataAppuntamento] = " & PK_Data_pause & " AND " & _
"[OraAppuntamento]= #" & PK_Ora_pause & "#"
rsA.MoveFirst
rsA.FindFirst strFilt_pause
If Not rsA.NoMatch Then
strObj_pause = ";" & rsA!Oggetto & ";" & rsA!Stato
End If
End If
mList.AddItem PK_Data_pause & ";" & PK_Ora_pause & ";" & strObj_pause
'CODICE PER INSERIRE LA PAUSA NELLA TABELLA APPUNTAMENTI
Dim giorno1 As String
Dim mese1 As String
Dim anno1 As String
Dim datatotale As String

'SCOMPONGO LA DATA IN GIORNO MESE E ANNO
giorno1 = Mid(PK_Data_pause, 10, 2)
mese1 = Mid(PK_Data_pause, 7, 2)
anno1 = Mid(PK_Data_pause, 2, 4)
'RIMETTO LA DATA INSIEME IN FORMATO ITALIANO E NON AMERICANO
datatotale = giorno1 & "/" & mese1 & "/" & anno1
'CONVERTO LA DATA IN DATE DA STRINGA
Dim datafinale As Date
datafinale = CStr(datatotale)

'CONVERTO L'ORA IN DATE DA STRINGA
Dim orafinale As Date
orafinale = FormatDateTime(PK_Ora_pause, vbShortTime)


'CONTROLLO SE ESISTE GIA' LA VOCE DELLA PAUSA
Dim RsCodice As DAO.Recordset
Dim Percorso As String
Dim dbs As DAO.Database


Percorso = CurrentDb.Name

Set dbs = OpenDatabase(Percorso, False)
Set RsCodice = dbs.OpenRecordset("SELECT * FROM T_Appuntamenti where DataAppuntamento= " & PK_Data_pause & " And OraAppuntamento= #" & PK_Ora_pause & "#")


If IsNull(RsCodice) = True Then

'STRINGA PER INSERIRE NELLA TABELLA APPUNTAMENTI LA PAUSA DALLE 13 ALLE 13.30 A NOME CHIARA NACCI
DoCmd.RunSQL ("INSERT INTO T_Appuntamenti ([Nome], [Cognome], [Oggetto], [DataAppuntamento], [OraAppuntamento]) VALUES ('GOMME','GOMME','PAUSA', " & datafinale & ", #" & orafinale & "#)")


End If
Next
' Ripristino l'Item Selezionato prima della ricompilazione
mList.Selected(itemSel_pause) = True


' Effettuamo un ciclo PER LA SERA
For k = 0 To intDelta_sera
PK_Ora_sera = Format$(DateAdd("n", k * DELTA_TIME, START_TIME_SERA), "h:mm")
PK_Data_sera = TAG_Data
strObj_sera = ";-"
' Cerco nel RS un'eventuale Record con la Data/Ora attuale per recuperarne i dati come Oggetto e Stato
If Not (rsA.BOF And rsA.EOF) Then
strFilt_sera = "[DataAppuntamento] = " & PK_Data_sera & " AND " & _
"[OraAppuntamento]= #" & PK_Ora_sera & "#"
rsA.MoveFirst
rsA.FindFirst strFilt_sera
If Not rsA.NoMatch Then
strObj_sera = ";" & rsA!Oggetto & ";" & rsA!Stato


End If
End If
mList.AddItem PK_Data_sera & ";" & PK_Ora_sera & strObj_sera
Next
' Ripristino l'Item Selezionato prima della ricompilazione
mList.Selected(itemSel_sera) = True
Else
'------------CODICE PER SABATO ---------------------
Dim DeltaPausa1 As Integer
Dim DeltaLavoro1 As Integer
Dim d As Integer
Dim e As Integer
Dim Oggetto1 As String

'DEFINISCO LE MEZZ'ORE CHE CI SONO NELLA MATTINATA
For d = 0 To intDelta_mat
' ricavo l'ora per la Colonna(1) Visibile e la data completa
' da assegnare alla Colonna(0) non visibile ma che rappresenta la PK del Recordset
PK_Data_mat = TAG_Data
PK_Ora_mat = Format$(DateAdd("n", d * DELTA_TIME, START_TIME_MATTINA), "h:mm")
strObj_mat = ";-"
If Not (rsA.BOF And rsA.EOF) Then
strFilt_mat = "[DataAppuntamento] = " & PK_Data_mat & " AND " & _
"[OraAppuntamento]= #" & PK_Ora_mat & "#"
rsA.MoveFirst
rsA.FindFirst strFilt_mat
If Not rsA.NoMatch Then
strObj_mat = ";" & rsA!Oggetto & ";" & rsA!Stato
End If
End If
mList.AddItem PK_Data_mat & ";" & PK_Ora_mat & strObj_mat
Next

'DEFINISCO LE MEZZ'ORE CHE CI SONO NEL POMERIGGIO CHIUSO
'DeltaLavoro1 = 13
For e = 0 To intDelta_sabato
' ricavo l'ora per la Colonna(1) Visibile e la data completa
' da assegnare alla Colonna(0) non visibile ma che rappresenta la PK del Recordset
PK_Data_sabato = TAG_Data
PK_Ora_sabato = Format$(DateAdd("n", e * DELTA_TIME, START_TIME_SABATO), "h:mm")
Oggetto1 = ";CHIUSO"
mList.AddItem PK_Data_sabato & ";" & PK_Ora_sabato & Oggetto1
Next

' Ripristino l'Item Selezionato prima della ricompilazione
mList.Selected(itemSel_sabato) = True
End If
End Sub