28. september 2009 - 09:04Der er
21 kommentarer og 1 løsning
Hente filnavne ind i tabel fra mappe på c:\
Hej Jeg har en database: Hent_Fil_Navne.accdb. I denne database har en jeg en tabel: 001tblFilNvn, og i tabellen et felt: mdb. Jeg har en formular: 001frmTblFilNvn med en knap: Importer. Når jeg klikker på knappen, vil jeg gerne have at navnene på de filer, mdb filer, som ligger i mappen C:\Winfinans hentes ind i tabellen. Jeg mangler en VB kode til at kunne udføre denne hændelse. Det skal lige tilføjes at jeg forsøgt mig med et svar givet på et lignende spørgsmål på Eksperten fra 2003: http://www.eksperten.dk/spm/372926, men jeg kan ikke få det til at fungere. Nogen der kan hjælpe?
Jeg har forsøgt mig med følgende kode, men når jeg compile får jeg følgende fejl: User-defined type not defined ved nr. 2 linie: Dim cnn As ADODB.Connection.
Function HentFilListe(FilMappe As String)
Dim cnn As ADODB.Connection Dim rsFilNavne As ADODB.Recordset Dim strQuery As String Dim FilNavn As String Dim FilMappe As String
Set cnn = CurrentProject.Connection Set rsFilNavne = New ADODB.Recordset
FilNavn = "C:\winfinans\"
strQuery = "SELECT * FROM Filnavne order by mdb asc" rsFilNavne.Open strQuery, cnn, adOpenStatic, adLockOptimistic
If rsFilNavne.RecordCount > 0 Then rsFilNavne.MoveFirst FilNavn = Dir(FilMappe & "*.mdb") ' Hent det første filnavn. Do Until FilNavn = "" With rsFilNavne .AddNew !mdb = FilNavn .Update End With
FilNavn = Dir ' Hent næste datafilnavn. rsFilNavne.MoveNext Loop
Else MsgBox "Der findes ingen filer i " & FilMappe, vbExclamation, "Ingen filer" End If
Nu kan jeg godt få lov at compile.Jeg har lavet koden i en mappe, modules, i vb. Når jeg skal kopiere den over til det sted den skal bruges, nemlig i tilknytning til knappen i formularen, skal jeg vælge et eller andet 'ved klik'. Men det kan da ikke være en hændelse når det er en funktion, eller hvad?
Dim cnn As ADODB.Connection Dim rsFilNavne As ADODB.Recordset Dim strQuery As String Dim FilNavn As String
Set cnn = CurrentProject.Connection Set rsFilNavne = New ADODB.Recordset
FilNavn = "C:\winfinans\"
strQuery = "SELECT * FROM Filnavne order by mdb asc" rsFilNavne.Open strQuery, cnn, adOpenStatic, adLockOptimistic
If rsFilNavne.RecordCount > 0 Then rsFilNavne.MoveFirst FilNavn = Dir(FilMappe & "*.mdb") ' Hent det første filnavn. Do Until FilNavn = "" With rsFilNavne .AddNew !mdb = FilNavn .Update End With
FilNavn = Dir ' Hent næste datafilnavn. rsFilNavne.MoveNext Loop
Else MsgBox "Der findes ingen filer i " & FilMappe, vbExclamation, "Ingen filer" End If
rsFilNavne.Close cnn.Close
End Sub
Men når jeg klikker på knappen i formularen får jeg en fejlmedelelse: Kan ikke finde inputtabellen eller forespørgslen filnavne. Og når jeg debugger viser den gult ved: rsFilNavne.Open strQuery, cnn, adOpenStatic, adLockOptimistic
Private Sub Command0_Click() On Error GoTo Error_Command0_Click Const strFilmappe = "C:\Temp\" Dim rst As ADODB.Recordset Dim strSQL As String Dim FilNavn As String
Set rst = New ADODB.Recordset strSQL = "SELECT fldFilename FROM 001tblFilNvn"
Do Until FilNavn = "" With rst .AddNew !fldFilename = FilNavn .Update End With FilNavn = Dir Loop
rst.Close Set rst = Nothing
Exit_Command0_Click: Exit Sub
Error_Command0_Click: Select Case Err.Number Case 3219 Case 3021 Case 2501 Case Is < 0 Resume Next Case Else MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error in procedure 'Command0_Click'" End Select Resume Exit_Command0_Click
Al din sortering og movefirst m.m. er unødvendig kode. Dir tager filnavne 'in no particular order' så du har først noget ud af at sortere bagefter og det gør du bare i den query du bygger på din tabel.
Min kode har fejlcheck for eksisterende filnavne så hvis der ikke er nye, så dukker der ikke flere op i tabellen. Der er ingen check for om filer er slettet.
Dim cnn As ADODB.Connection Dim rsFilNavne As ADODB.Recordset Dim strQuery As String Dim FilNavn As String
Set cnn = CurrentProject.Connection Set rsFilNavne = New ADODB.Recordset
FilMappe = "C:\winfinans\"
strQuery = "SELECT * FROM 001tblFilNvn order by Filnavne asc" rsFilNavne.Open strQuery, cnn, adOpenStatic, adLockOptimistic
If rsFilNavne.RecordCount > 0 Then rsFilNavne.MoveFirst FilNavn = Dir(FilMappe & "*.mdb") ' Hent det første filnavn. Do Until FilNavn = "" With rsFilNavne .AddNew !Filnavne = FilNavn .Update End With
FilNavn = Dir ' Hent næste datafilnavn. rsFilNavne.MoveNext Loop
Else MsgBox "Der findes ingen filer i " & FilMappe, vbExclamation, "Ingen filer" End If
rsFilNavne.Close cnn.Close
And as Hugo points out the code could be slightly different, but this works.
Hugo points out that you could optimize the code a little by removing the ORDER BT inthe SQL and also .MoveNext on the recordset which isnt really necessary when you are just adding records.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.