Newsgroup: it.comp.appl.access
Titolo: collegarsi a mdb da excel

ciao a tutti,
ho creato una routine in access che mi apre un modello excel, lo
compila con dati provenienti da access e lo salva con un determinato
nome, alla riapertura del file (sempre da access recupera i dati di
alcune celle e li salva in una tabella)
Il problema è che non voglio aspettare di riaprirlo per recuperare i
dati, ma vorrei che sull'evento chiusura di excel si collegasse ad
access ed sportasse alcuni dati.
--------------------------------------------------------------------------------------------------------------------------------------------------------------
PER EVENTUALI USI POSTO IL CODICE FATTO FINO AD ADESSO:
Dim Tipo As Integer
Dim strSQl As String
Dim dbmio As Database
Dim rcdprevsopr, rcdpat, rcdofferte, rcdfatture, rcdbolle, rcdlettere,
rcdfax As Recordset
Tipo = [Forms]![Scheda tecnica].[Tipo]
DoCmd.Hourglass (True)
Dim strFinalDoc, Path As String
Dim appexcel, fs, msoSortbyFileName, msoSortOrderAscending, i As
Variant
Dim univoco As String
   On Error Resume Next
   Path = CurrentProject.Path & "\Scheda tecnica\Scheda_tecnica_nr_"
   univoco = Me!Id
   strFinalDoc = Path & univoco & ".xls"
Set fs = Application.FileSearch
With fs
    .newsearch
    .LookIn = Chr(34) & CurrentProject.Path & "\Scheda tecnica\" &
Chr(34)
    .FileName = "*.*"
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
            If .FoundFiles(i) = Path & univoco & ".xls" Then
                MsgBox "Il documento è già stato creato! clicca apri
scheda"
                DoCmd.Hourglass (False)
                Exit Sub
            End If
        Next i
        GoTo 11
    Else
11
DoCmd.Hourglass (False)
DoCmd.SetWarnings (False)
strSQl = "SELECT TestatePreventivi.NrRA, TestatePreventivi.[Idprev-
sopr], TestatePreventivi.[Dataprev-sopr] INTO T_rcdprevsopr FROM
TestatePreventivi WHERE (((TestatePreventivi.NrRA)=[Forms]![Scheda
tecnica]![commessa])) ORDER BY TestatePreventivi.[idprev-sopr],
TestatePreventivi.[DataPrev-sopr];"
DoCmd.RunSQL strSQl
strSQl = "SELECT TestatePAT.NrRA, TestatePAT.IdPAT, TestatePAT.DataPAT
INTO T_rcdpat FROM TestatePAT WHERE (((TestatePAT.NrRA)=[Forms]!
[Scheda tecnica]![commessa])) ORDER BY TestatePAT.IdPAT,
TestatePAT.DataPAT;"
DoCmd.RunSQL strSQl
strSQl = "SELECT Testateofferte.NrRA, Testateofferte.Idofferta,
Testateofferte.Dataofferta INTO T_rcdofferte FROM Testateofferte WHERE
(((Testateofferte.NrRA)=[Forms]![Scheda tecnica]![commessa])) ORDER BY
Testateofferte.Idofferta, Testateofferte.Dataofferta;"
DoCmd.RunSQL strSQl
strSQl = "SELECT Testatefatture.NrRA, Testatefatture.Idfattura,
Testatefatture.Datafattura INTO T_rcdfatture FROM Testatefatture WHERE
(((Testatefatture.NrRA)=[Forms]![Scheda tecnica]![commessa])) ORDER BY
Testatefatture.Idfattura, Testatefatture.Datafattura;"
DoCmd.RunSQL strSQl
strSQl = "SELECT Testatebolle.NrRA, Testatebolle.Idbolla,
Testatebolle.Databolla INTO T_rcdbolle FROM Testatebolle WHERE
(((Testatebolle.NrRA)=[Forms]![Scheda tecnica]![commessa])) ORDER BY
Testatebolle.Idbolla, Testatebolle.Databolla;"
DoCmd.RunSQL strSQl
strSQl = "SELECT Testatelettere.NrRA, Testatelettere.Idlettera,
Testatelettere.Datalettera INTO T_rcdlettere FROM Testatelettere WHERE
(((Testatelettere.NrRA)=[Forms]![Scheda tecnica]![commessa])) ORDER BY
Testatelettere.Idlettera, Testatelettere.Datalettera;"
DoCmd.RunSQL strSQl
strSQl = "SELECT Testatefax.NrRA, Testatefax.nostroriferimento,
Testatefax.Datafax INTO T_rcdfax FROM Testatefax WHERE
(((Testatefax.NrRA)=[Forms]![Scheda tecnica]![commessa])) ORDER BY
Testatefax.nostroriferimento, Testatefax.datafax;"
DoCmd.RunSQL strSQl
DoCmd.SetWarnings (True)
Set dbmio = CurrentDb
Set rcdprevsopr = dbmio.OpenRecordset("T_rcdprevsopr")
Set rcdpat = dbmio.OpenRecordset("T_rcdpat")
Set rcdofferte = dbmio.OpenRecordset("T_rcdofferte")
Set rcdfatture = dbmio.OpenRecordset("T_rcdfatture")
Set rcdbolle = dbmio.OpenRecordset("T_rcdbolle")
Set rcdlettere = dbmio.OpenRecordset("T_rcdlettere")
Set rcdfax = dbmio.OpenRecordset("T_rcdfax")
Dim xlApp As Excel.Application     '<---- riferimento all'applicazione
Excel
Dim xlBook As Excel.Workbook       '<---- riferimento al Workbook
Dim xlSheet As Excel.Worksheet     '<---- riferimento al Worksheet
Dim percorso As String
'poi crei un'oggetto Applicazione Excel, assegnandola alla variabile
che la identifica:
Set xlApp = CreateObject("Excel.Application")
'poi associ ai riferimenti del workbook il il File Excel che vuoi
aprire:
Select Case Tipo
    Case 1
        Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path &
"\Scheda tecnica\Vuoto.xlt")
    Case 2
        Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path &
"\Scheda tecnica\Excel Vuoto.xlt")
End Select
'e infine definisci il foglio di lavoro:
Set xlSheet = xlBook.Worksheets("INTESTAZIONE")
'per rendere visibile l'applicazione Excel, che di default rimane
"nascosta", rilevabile solo attraverso il Task Manager:
'xlApp.Visible=True, e per nasconderla ovviamente xlApp.Visible=False
xlApp.Visible = True
xlSheet.Activate    '<--- attiva il foglio di lavoro
On Error Resume Next
xlSheet.Range("AO7").Value = [Forms]![Scheda tecnica].[RA].Column(1)
xlSheet.Range("BH7").Value = [Forms]![Scheda tecnica].[M_commessa]!
Descrizione
xlSheet.Range("AO10").Value = [Forms]![Scheda tecnica].[M_commessa]!
[ex-ra]
xlSheet.Range("BH10").Value = [Forms]![Scheda tecnica].[M_commessa]!
[anno]
xlSheet.Range("BH13").Value = [Forms]![Scheda tecnica]![Id]
xlSheet.Range("AO13").Value = [Forms]![Scheda tecnica].[M_commessa]!
[CodStato] & " - " & [Forms]![Scheda tecnica].[M_commessa]!
CodStato.Column(1)
xlSheet.Range("AO16").Value = [Forms]![Scheda tecnica].[M_commessa]!
Note
xlSheet.Range("AO19").Value = [Forms]![Scheda tecnica].[M_commessa]!
[CodiceCoordinatore] & " - " & [Forms]![Scheda tecnica].[M_commessa]!
[CodiceCoordinatore].Column(1)
xlSheet.Range("BH19").Value = [Forms]![Scheda tecnica].[M_commessa]!
[CodiceRichiedente] & " - " & [Forms]![Scheda tecnica].[M_commessa]!
CodiceRichiedente.Column(1)
xlSheet.Range("AO22").Value = [Forms]![Scheda tecnica].[M_commessa]!
[cc_società] & " - " & [Forms]![Scheda tecnica].[M_commessa]!
[cc_società].Column(1)
xlSheet.Range("BH22").Value = [Forms]![Scheda tecnica].[M_commessa]!
area & " - " & [Forms]![Scheda tecnica].[M_commessa]!area.Column(1)
xlSheet.Range("AO25").Value = [Forms]![Scheda tecnica].[M_commessa]!
CodSettore & " - " & [Forms]![Scheda tecnica].[M_commessa]!
CodSettore.Column(1)
xlSheet.Range("BH25").Value = [Forms]![Scheda tecnica].[M_commessa]!
Prodotto & " - " & [Forms]![Scheda tecnica].[M_commessa]!
Prodotto.Column(1)
If IsNull([Forms]![Scheda tecnica].[RA].Column(14)) = True Then GoTo 1
If IsNull([Forms]![Scheda tecnica].[RA].Column(13)) = True Then
    xlSheet.Range("BH33").Value = "n°" & [Forms]![Scheda tecnica].
[RA].Column(14)
    GoTo 1
Else
    xlSheet.Range("BH33").Value = "n°" & [Forms]![Scheda tecnica].
[RA].Column(14) & " del " & [Forms]![Scheda tecnica].[RA].Column(13)
End If
1
rcdprevsopr.MoveLast
rcdprevsopr.MoveFirst
Do Until rcdprevsopr.EOF
        xlSheet.Range("AO29").Value = "n°" & rcdprevsopr("IdPREV-
SOPR") & " del " & rcdprevsopr("DataPREV-SOPR")
        rcdprevsopr.MoveNext
        xlSheet.Range("AO30").Value = "n°" & rcdprevsopr("IdPREV-
SOPR") & " del " & rcdprevsopr("DataPREV-SOPR")
        rcdprevsopr.MoveNext
        xlSheet.Range("AX29").Value = "n°" & rcdprevsopr("IdPREV-
SOPR") & " del " & rcdprevsopr("DataPREV-SOPR")
        rcdprevsopr.MoveNext
        xlSheet.Range("AX30").Value = "n°" & rcdprevsopr("IdPREV-
SOPR") & " del " & rcdprevsopr("DataPREV-SOPR")
        Exit Do
Loop
Set rcdprevsopr = Nothing
rcdprevsopr.Close
rcdpat.MoveLast
rcdpat.MoveFirst
Do Until rcdpat.EOF
        xlSheet.Range("BH29").Value = "n°" & rcdpat("IdPAT") & " del "
& rcdpat("DataPAT")
        rcdpat.MoveNext
        xlSheet.Range("BH30").Value = "n°" & rcdpat("IdPAT") & " del "
& rcdpat("DataPAT")
        rcdpat.MoveNext
        xlSheet.Range("BQ29").Value = "n°" & rcdpat("IdPAT") & " del "
& rcdpat("DataPAT")
        rcdpat.MoveNext
        xlSheet.Range("BQ30").Value = "n°" & rcdpat("IdPAT") & " del "
& rcdpat("DataPAT")
        Exit Do
Loop
Set rcdpat = Nothing
rcdpat.Close
rcdofferte.MoveLast
rcdofferte.MoveFirst
Do Until rcdofferte.EOF
        xlSheet.Range("AO33").Value = "n°" & rcdofferte("IdOFFERTA") &
" del " & rcdofferte("DataOFFERTA")
        rcdofferte.MoveNext
        xlSheet.Range("AO34").Value = "n°" & rcdofferte("IdOFFERTA") &
" del " & rcdofferte("DataOFFERTA")
        rcdofferte.MoveNext
        xlSheet.Range("AX33").Value = "n°" & rcdofferte("IdOFFERTA") &
" del " & rcdofferte("DataOFFERTA")
        rcdofferte.MoveNext
        xlSheet.Range("AX34").Value = "n°" & rcdofferte("IdOFFERTA") &
" del " & rcdofferte("DataOFFERTA")
        Exit Do
Loop
Set rcdofferte = Nothing
rcdofferte.Close
rcdfatture.MoveLast
rcdfatture.MoveFirst
Do Until rcdfatture.EOF
        xlSheet.Range("AO37").Value = "n°" & rcdfatture("IdFATTURA") &
" del " & rcdfatture("DataFATTURA")
        rcdfatture.MoveNext
        xlSheet.Range("AO38").Value = "n°" & rcdfatture("IdFATTURA") &
" del " & rcdfatture("DataFATTURA")
        rcdfatture.MoveNext
        xlSheet.Range("AX37").Value = "n°" & rcdfatture("IdFATTURA") &
" del " & rcdfatture("DataFATTURA")
        rcdfatture.MoveNext
        xlSheet.Range("AX38").Value = "n°" & rcdfatture("IdFATTURA") &
" del " & rcdfatture("DataFATTURA")
        Exit Do
Loop
Set rcdfatture = Nothing
rcdfatture.Close
rcdbolle.MoveLast
rcdbolle.MoveFirst
Do Until rcdbolle.EOF
        xlSheet.Range("BH37").Value = "n°" & rcdbolle("IdBOLLA") & "
del " & rcdbolle("DataBOLLA")
        rcdbolle.MoveNext
        xlSheet.Range("BH38").Value = "n°" & rcdbolle("IdBOLLA") & "
del " & rcdbolle("DataBOLLA")
        rcdbolle.MoveNext
        xlSheet.Range("BQ37").Value = "n°" & rcdbolle("IdBOLLA") & "
del " & rcdbolle("DataBOLLA")
        rcdbolle.MoveNext
        xlSheet.Range("BQ38").Value = "n°" & rcdbolle("IdBOLLA") & "
del " & rcdbolle("DataBOLLA")
        Exit Do
Loop
Set rcdbolle = Nothing
rcdbolle.Close
rcdlettere.MoveLast
rcdlettere.MoveFirst
Do Until rcdlettere.EOF
        xlSheet.Range("AO41").Value = "n°" & rcdlettere("IdLETTERA") &
" del " & rcdlettere("DataLETTERA")
        rcdlettere.MoveNext
        xlSheet.Range("AO42").Value = "n°" & rcdlettere("IdLETTERA") &
" del " & rcdlettere("DataLETTERA")
        rcdlettere.MoveNext
        xlSheet.Range("AX41").Value = "n°" & rcdlettere("IdLETTERA") &
" del " & rcdlettere("DataLETTERA")
        rcdlettere.MoveNext
        xlSheet.Range("AX42").Value = "n°" & rcdlettere("IdLETTERA") &
" del " & rcdlettere("DataLETTERA")
        Exit Do
Loop
Set rcdlettere = Nothing
rcdlettere.Close
rcdfax.MoveLast
rcdfax.MoveFirst
Do Until rcdfax.EOF
        xlSheet.Range("BH41").Value = "n°" &
rcdfax("nostroriferimento") & " del " & rcdfax("Datafax")
        rcdfax.MoveNext
        xlSheet.Range("BH42").Value = "n°" &
rcdfax("nostroriferimento") & " del " & rcdfax("Datafax")
        rcdfax.MoveNext
        xlSheet.Range("BQ41").Value = "n°" &
rcdfax("nostroriferimento") & " del " & rcdfax("Datafax")
        rcdfax.MoveNext
        xlSheet.Range("BQ42").Value = "n°" &
rcdfax("nostroriferimento") & " del " & rcdfax("Datafax")
        Exit Do
Loop
Set rcdfax = Nothing
rcdfax.Close
'xlSheet.Range("AO29").Value = [Forms]![Scheda tecnica].[M_idprevsopr]!
[IDPREV-SOPR] & " del " & Format([Forms]![Scheda tecnica].
[M_idprevsopr]![DATAprev-sopr], "short date")
'xlSheet.Range("BH29").Value = [Forms]![SCHEDA TECNICA].[M_idpat]!
IDPAT & " del " & [Forms]![SCHEDA TECNICA].[M_idpat]!DATAPAT
'xlSheet.Range("AO33").Value = [Forms]![Scheda tecnica].[m_idofford]!
IDOFFERTA & " del " & [Forms]![Scheda tecnica].[m_idofford]!
DATAOFFERTA
'xlSheet.Range("AO37").Value = [Forms]![Scheda tecnica].[M_idfattura]!
IDFATTURA & " del " & [Forms]![Scheda tecnica].[M_idfattura]!
DATAFATTURA
'xlSheet.Range("BH37").Value = [Forms]![Scheda tecnica].[m_idbolla]!
IDBOLLA & " del " & [Forms]![Scheda tecnica].[m_idbolla]!DATABOLLA
'xlSheet.Range("AO41").Value = [Forms]![Scheda tecnica].[m_idlettere]!
IdLettera & " del " & [Forms]![Scheda tecnica].[m_idlettere]!
DataLettera
'xlSheet.Range("BH41").Value = [Forms]![Scheda tecnica].[m_idfax]!
NOSTRORIF & " del " & [Forms]![Scheda tecnica].[m_idfax]!DATAFAX
Select Case Tipo
Case 1
    Set xlSheet = xlBook.Worksheets("SCHEDA")
    xlSheet.Activate
    xlSheet.Range("A1").Value = "RA: " & [Forms]![Scheda tecnica].
[RA].Column(1) & "        DESCRIZIONE: " & [Forms]![Scheda tecnica].
[M_commessa]!Descrizione & "        STATO: " & [Forms]![Scheda
tecnica].[M_commessa]![CodStato] & " - " & [Forms]![Scheda tecnica].
[M_commessa]!CodStato.Column(1)
    xlSheet.Range("A2").Value = "    SCHEDA TECNICA N°: " & [Forms]!
[Scheda tecnica]![Id] & "                    SOCIETA': " & [Forms]!
[Scheda tecnica].[M_commessa]![cc_società] & " - " & [Forms]![Scheda
tecnica].[M_commessa]![cc_società].Column(1) & "       RICHIEDENTE: "
& [Forms]![Scheda tecnica].[M_commessa]![CodiceRichiedente] & " - " &
[Forms]![Scheda tecnica].[M_commessa]!CodiceRichiedente.Column(1) &
"        AREA: " & [Forms]![Scheda tecnica].[M_commessa]!area & " - "
& [Forms]![Scheda tecnica].[M_commessa]!area.Column(1) & ""
    xlSheet.Range("A3").Value = "
LEGENDA:                                     / = NON PREVISTO;      0
= DA FARE;    1 = IN CORSO;   2 = FATTO;      S = SOSPESO;    A =
ANNULLATO."
    xlSheet.OLEObjects("CheckBox1").Object.Value = 1
    xlBook.Sheets("Scheda").name = "Scheda"
    Range("B9").Select
    Me.data_aggiornamento = xlSheet.Range("T5").Value
    Me.TotAV = xlSheet.Range("S36").Value
    Me.TotPrev = xlSheet.Range("C36").Value
Case 2
    Set xlSheet = xlBook.Worksheets("INTESTAZIONE")
    Me.data_aggiornamento = xlSheet.Range("AX44").Value
End Select
percorso = "file:" & CurrentProject.Path & "\Scheda tecnica
\Scheda_tecnica_nr_" & [Forms]![Scheda tecnica].[Id] & ".xls"
xlBook.SaveAs FileName:=percorso, FileFormat:=xlNormal, Password:="",
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
'xlBook.Close (False) '<--- chiudi il foglio di lavoro salvando (true)
o non salvando (False)
'xlBook.Close
'xlSheet
'xlApp.Quit                                '<--- chiudi l'applicazione
excel
'annienta le variabili utilizzate.
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
        Exit Sub
    End If
    .newsearch
End With

 access ed sportasse alcuni dati.
Ciao.
Cioè in pratica hai bisogno di scriverti un po' di codice all'interno
del foglio xls perché sull'evento chiusura dello workbook venga
avviata una applicazione access che faccia tutti gli aggiornamenti del
caso.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim appAggiornamento As Access.Application
    Dim rsDati As DAO.Recordset
    Set appAggiornamento = CreateObject("Access.Application")
    Set rsDati =
appAggiornamento.CurrentDb.OpenRecordset("TabellaDaAggiornare")
    'qua metti il codice che effettuerà l'aggiornamento dei dati
    rsDati.Close
    Set rsDati = Nothing
    appAggiornamento.Quit acQuitSaveNone
    Set appAggiornamento = Nothing
End Sub
HTH
Popi


La routine da errore forse perchè il database access è un file già
esistente e non da creare; ho porvato allora a scrivere il seguente
codice:
Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
    Dim rsDati As DAO.Recordset
    Dim sql as string
        sql = "SELECT [T_temp].* FROM t_temp"
        Set rsDati = OpenDatabase("\\server\Programmi\Tecnici\scheda
tecnica.mdb").OpenRecordset(sql, DAO.dbOpenSnapshot,
DAO.dbFailOnError)
        rsDati.AddNew
        rsDati![oreav] = Range("D12").value
        rsDati![orecs] = Range("E12").value
        rsDati.Update
        rsDati.Close
        Set rsDati= Nothing
End Sub
ma mi da il seguente errore "Operazione non supportata per questo
oggetto"
sulla riga "rsDati.AddNew"
attendendo un suggerimento ringrazio per l'aiuto
ciao
Andrea

 attendendo un suggerimento ringrazio per l'aiuto
Un openRecordset all'interno di un openDatabase mi sembra una cosa
"poco pulita" cmq il suggerimento è solo uno: guardati l'help di
openRecordset, in special modo la parte relativa alle diverse modalità
di apertura (snapshot, per intenderci).
HTH
Popi

 - Mostra testo citato -
TUTTO OK GRAZIE
Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
If datagg = "0.00.00 " Then Exit Sub
    Sheets("Scheda").Select
    Range("T5").Select
    ActiveCell.FormulaR1C1 = datagg
    Range("F2").Select
Dim objDaoDbs As Object
Set objDaoDbs = CreateObject("DAO.DBEngine.36").OpenDatabase("\\server
\Programmi\Tecnici\scheda tecnica.mdb").OpenRecordset("T_temp")
objDaoDbs.AddNew
objDaoDbs![dataagg] = Range("T5")
objDaoDbs![orepr] = Range("C36")
objDaoDbs![oreav] = Range("S36")
    Sheets("intestazione").Select
objDaoDbs![idscheda] = Range("BH13")
objDaoDbs.Update
objDaoDbs.Close
Set objDaoDbs = Nothing
Set objDaoDbe = Nothing
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
datagg = Date
End Sub