3265: Elemento non trovato in questo insieme.
Giovanni
Nel codice qui di seguito elencato, avviene l'esportazione di alcuni campi
della tabella Contatti.
Ora vorrei utilizzare il medesimo codice per esportare dei campi anche per
la tabella Dipendenti. Ma alla sostituzione della parola "Contatti" con
"Dipendenti" e all'avvio del codice tramite pulsante ho questo errore:
3265: Elemento non trovato in questo insieme.
Gentilmente qualcuno mi può aiutare dicendomi dove sto sbagliando? Grazie
per la Vs gentile collaborazione.
Giovanni
Private Sub Esporta(Export As String)
Dim DB As Database, DB2 As Database
Dim tdf As TableDef
Dim fld As Field
Dim idx As Index
Dim sqlStr As String
Dim myRst As Recordset
Dim hisRst As Recordset
Dim dir As String
Dim appWord As Object
Dim newDoc As Object
On Error GoTo Err_Export
dir = GetOption("Default Database Directory") & "\"
If dir = "\" Or dir = ".\" Then
dir = "C:\Documenti\"
End If
Select Case Export
Case "Access":
dir = dir & "contatti.MDB"
' Rimuovete il commento posto sulla linea di
codice seguente per
' attivare la finestra "Salva nella cartella" e
memorizzare il file in una
' cartella qualsiasi come database Access
' dir = SalvaConNome("Database Access " &
Strings.Chr$(0) & "*.mdb" & Strings.Chr$(0) & Strings.Chr$(0),
DefExtension:="xls")
sqlStr = "SELECT DISTINCTROW * FROM contatti"
Case "Excel":
dir = dir & "contatti.XLS"
' Rimuovete il commento posto sulla linea di
codice seguente per
' attivare la finestra "Salva nella cartella" e
memorizzare il file in una
' cartella qualsiasi come foglio Excel
' dir = SalvaConNome("File Excel ",
DefExtension:="xls")
sqlStr = "SELECT DISTINCTROW * FROM contatti"
Case "Stampa Unione":
sqlStr = "SELECT DISTINCTROW * FROM Contatti"
End Select
If CodeContextObject.FilterOn Then
sqlStr = sqlStr & " WHERE " & CodeContextObject.Filter
End If
sqlStr = sqlStr & ";"
Set DB = CurrentDb()
Set tdf = DB.CreateTableDef("TEMP")
Set fld = tdf.CreateField("ID", dbLong)
fld.Attributes = fld.Attributes + dbAutoIncrField
tdf.Fields.Append fld
Set fld = tdf.CreateField("Cognome", dbText, 50)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Nome", dbText, 50)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Indirizzo", dbText, 50)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Cap", dbText, 5)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Città", dbText, 50)
tdf.Fields.Append fld
Set idx = tdf.CreateIndex("ID")
Set fld = idx.CreateField("ID", dbInteger)
idx.Fields.Append fld
idx.Primary = True
tdf.Indexes.Append idx
DB.TableDefs.Append tdf
DB.TableDefs.Refresh
Set hisRst = DB.OpenRecordset("TEMP")
Set myRst = DB.OpenRecordset(sqlStr, dbOpenDynaset)
myRst.MoveFirst
Do Until myRst.EOF
hisRst.AddNew
hisRst!Cognome = myRst!Cognome
hisRst!Nome = myRst!Nome
hisRst!Indirizzo = myRst!Indirizzo
hisRst!Cap = myRst!Cap
hisRst!Città = myRst!Città
hisRst.Update
myRst.MoveNext
Loop
Select Case Export
Case "Access":
If dir <> "" Then
Set DB2 = CreateDatabase(dir, dbLangGeneral)
DB2.CreateTableDef "Contatti"
DB2.Close
DoCmd.TransferDatabase acExport, "Microsoft
Access", dir, , "TEMP", "contatti"
MsgBox "I dati sono stati esportati nel file " &
dir & " .", vbOKOnly, "Esportazione in DB Access completata"
End If
Case "Excel":
If dir <> "" Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel97, "TEMP", dir
MsgBox "I dati sono stati esportati nel file " &
dir & " .", vbOKOnly, "Esportazione in file Excel completata"
End If
Case "Stampa Unione":
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
Set appWord =
CreateObject("Word.Application")
End If
appWord.Visible = True
appWord.Activate
Set newDoc = appWord.Documents.Add
newDoc.MailMerge.OpenDataSource CurrentDb.Name,
, , , True, False, , , False, , , "TABLE TEMP"
End Select
myRst.Close
hisRst.Close
On Error Resume Next
DB.TableDefs.Delete "TEMP"
If Err.Number <> 0 Then
If Err.Number <> 3011 And Err.Number <> 3211 Then GoTo Err_Export
Err.Clear
End If
On Error GoTo Err_Export
DB.TableDefs.Refresh
DB.Close
Exit_Export:
Set newDoc = Nothing
Set appWord = Nothing
Set hisRst = Nothing
Set myRst = Nothing
Set idx = Nothing
Set fld = Nothing
Set tdf = Nothing
Set DB = Nothing
Set DB2 = Nothing
Exit Sub
Err_Export:
Select Case Err.Number
Case 3010:
DB.TableDefs.Delete "TEMP"
Resume
Case 3262:
Resume Exit_Export
Case Else:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Export
End Select
End Sub
Paolo Beltrame
> ...
> Nel codice qui di seguito elencato, avviene l'esportazione di alcuni campi
> della tabella Contatti.
> Ora vorrei utilizzare il medesimo codice per esportare dei campi anche per
A quest'ora di notte non ho ben esaminato il tuo codice, ma mi
e' venuta in mente una circostanza simile mai capita (mi ero ripromesso
almeno di tentare) che mi dava il tuo stesso tuo errore.
Risolta scrivendo al posto rs!NomeCampo oppure rs("NomeCampo")
l'indice del campo, cioe':
rs(0) = CosaVuoi
rs(1) = CosaltroVuoi
etc.
Il recordset a cui mi riferisco era dimensionato e settato dentro
la stessa sub, cio' esclude un errore d'istanza, cosi' funziona,
se cambi in rs!NomeCampo non va' piu', da' l'errore menzionato.
Paolo
Antonio Biso
>Un saluto a tutti.
>Nel codice qui di seguito elencato, avviene l'esportazione di alcuni campi
>della tabella Contatti.
>Ora vorrei utilizzare il medesimo codice per esportare dei campi anche per
>la tabella Dipendenti. Ma alla sostituzione della parola "Contatti" con
>"Dipendenti" e all'avvio del codice tramite pulsante ho questo errore:
>3265: Elemento non trovato in questo insieme.
>
>Gentilmente qualcuno mi può aiutare dicendomi dove sto sbagliando? Grazie
>per la Vs gentile collaborazione.
>Giovanni
Magari se dicevi la riga dove l'errore si generava era meglio...
> Set hisRst = DB.OpenRecordset("TEMP")
> Set myRst = DB.OpenRecordset(sqlStr, dbOpenDynaset)
>
> myRst.MoveFirst
> Do Until myRst.EOF
> hisRst.AddNew
> hisRst!Cognome = myRst!Cognome
> hisRst!Nome = myRst!Nome
> hisRst!Indirizzo = myRst!Indirizzo
> hisRst!Cap = myRst!Cap
> hisRst!Città = myRst!Città
Solo un piccolo commento: avendo creato la tabella temp uguale alla tabella
sorgente, potevi fare queste righe in questo modo
Do Until myRst.EOF
for i = 0 to hisRst.fields.count - 1
hisRst.fields(i) = myRst.fields(i)
next i
Antonio
Giovanni
Giovanni Bianchi