Hallo OctaFish. Ik gebruik een database met mogelijkheid voor opslag van bijlagen. Je hebt mij geholpen met een vraag in de periode 30 juli - 6 augustus (zoek op KPTPTT Bijlagen opslaan op een andere locatie). Het betreft een formulier Bijlagen waarin bijlagen worden opgeslagen op een centrale schijf dmv drive mapping S:/ waaronder een UNC pad en de bestandnaam in de database in een veld(en) van de tabel Bijlagen is opgeslagen.
Het opslaan van de bijlagen (bestandsnamen) gaat soms goed maar ook verkeerd. Vanwege de errorafhandeling wordt dan de melding: "Het bestand ontbreekt in de dossiermap" gegeven, hetgeen logisch is. Bij nader onderzoek (error afhandeling buiten werking) blijkt een foutmelding te worden gegeven Fout 2147352567 "U kunt geen waarde aan dit object toekennen". Dit gebeurt bij de regel: "Me.Bijlage1=funBijlageToevoegen(Me.BijlagePad1). Bijlage1 is het veld in de tabel waarin de bestandsnaam wordt opgeslagen en BijlagePad1 is het veld waarin het pad van de map wordt opgeslagen.
De voorafgaande regel FileCopy sFile etc., waarbij gekopieerd wordt met de toegewezen schijfen U: en S: netwerkverbinding/onderliggende UNC pad werkt volgens mij goed omdat de foutmelding een regel later plaatsvind.
Waarom gaat het fout? Er wordt in de tabel alleen maar een bestandsnaam opgeslagen. Moet Bijlage1 nog worden gedeclareerd? Zou een Error Resume Next helpen boven de foutregel, wat doet dan On Error GoTo Hell??
Het opslaan van de bijlagen (bestandsnamen) gaat soms goed maar ook verkeerd. Vanwege de errorafhandeling wordt dan de melding: "Het bestand ontbreekt in de dossiermap" gegeven, hetgeen logisch is. Bij nader onderzoek (error afhandeling buiten werking) blijkt een foutmelding te worden gegeven Fout 2147352567 "U kunt geen waarde aan dit object toekennen". Dit gebeurt bij de regel: "Me.Bijlage1=funBijlageToevoegen(Me.BijlagePad1). Bijlage1 is het veld in de tabel waarin de bestandsnaam wordt opgeslagen en BijlagePad1 is het veld waarin het pad van de map wordt opgeslagen.
De voorafgaande regel FileCopy sFile etc., waarbij gekopieerd wordt met de toegewezen schijfen U: en S: netwerkverbinding/onderliggende UNC pad werkt volgens mij goed omdat de foutmelding een regel later plaatsvind.
Code:
Option Compare Database
Const defPad As String = "D:\test database\" 'PAD WAAR DE BIJLAGEN WORDEN OPGESLAGEN (TIJDELIJK EEN ANDERE NAAM GEGEVEN EN IS s:/ SCHIJF)
Private Sub Bijlage1_DblClick(Cancel As Integer)
On Error GoTo Hell
If Me.Bijlage1 & "" = "" Then
If Me.BijlagePad1 & "" = "" Then Me.BijlagePad1 = defPad
Me.Bijlage1 = funBijlageToevoegen(Me.BijlagePad1) 'Bestandsnaam toevoegen aan tabel Bijlagen Doc2 HIER WORDT DE FOUTMELDING 2147352567 GEGEVEN.
Else
DoCmd.SetWarnings False
Application.FollowHyperlink Me.BijlagePad1 & Me.Bijlage1
DoCmd.SetWarnings True
End If
Exit Sub
Hell:
If MsgBox("Het bestand '" & LCase(Me.Bijlage1) & "' ontbreekt in de dossiermap; wil je het verwijderen uit de lijst?", vbYesNo) = vbYes Then
Me.Bijlage1 = Null
End If
End Sub
Private Function funBijlageToevoegen(BijlagePad1 As String) As String 'Kopieeren van het geslecteerd bestand naar de S-schijf.
Dim sFile As String
sFile = BestandOpzoeken(Application.CurrentProject.Path & "\") '2 C:\Users\mail\Documents\Doc2.pdf
If sFile = "Annuleren" Then Exit Function
If Not Dir(sFile) = "" Then
If InStr(1, sFile, "\") = 0 Or Dir(sFile) = "" Then Exit Function
funBijlageToevoegen = Split(sFile, "\")(UBound(Split(sFile, "\"))) '3 S:\Doc2.pdf
On Error Resume Next
FileCopy sFile, BijlagePad1 & funBijlageToevoegen 'Geselecteerde bestand kopiëren naar de S-schijf. S:\Doc2.pdf VOLGENS MIJ GAAT DIT GOED (ONDERLIGGEND UNC PAD)
End If
End Function
Code:
Option Compare Database
Public Function fPadMaken(sFolder As String) As String
On Error GoTo ErrorHandler
Dim sF As String
sF = GetPathOnly(sFolder)
If Dir(sF, vbDirectory) = "" Then
sF = fPadMaken(sF)
MkDir sF
End If
fPadMaken = sFolder
Exit Function
ErrorHandler:
Exit Function
End Function
Public Function GetPathOnly(sPath As String) As String
GetPathOnly = Left(sPath, InStrRev(sPath, "\", Len(sPath)) - 1)
End Function
Function BestandOpzoeken(Optional Pad As String) As String
Dim dlgPicker As Object
Dim sType() As String, sFile As String
Dim tmp As String, sPad As String
Dim bCheck As Boolean
Dim vrtSelectedItem As Variant
On Error GoTo Hell
If Pad = "" Then sPad = CreateObject("WScript.Shell").SpecialFolders("Mijn documenten") Else: sPad = Pad
If Right(sPad, 1) <> "\" Then sPad = sPad & "\"
Set dlgPicker = Application.FileDialog(3)
With dlgPicker
.Title = "Selecteer een bestand." 'De titel voor het venster
'.InitialFilename = sPad 'Waar moet het venster beginnen? (Dit was van een voorbeeldprogramma)
.InitialFilename = "D:\" 'INSTELLING VAN HET PAD WAAR DE BIJLAGEN ZIJN OPGESLAGEN OP DE S SCHIJF (IS EEN NETWERKVERBINDING)
With .Filters
.Clear
.Add "Alles", "*.*", 1 'Geen Beperkingen op bestandstype"
.Add "Microsoft Word", "*.doc; *.docx; *.docm", 2 'Beperk de bestandstypes tot .doc
.Add "Microsoft Excel", "*.xls; *.xlsx; *.xlsm", 3 'Beperk de bestandstypes tot .xls
.Add "Adobe Reader", "*.pdf", 4 'Beperk de bestandstypes tot .pdf"
.Add "Afbeeldingen", "*.jpg; *.jpeg; *.png", 5 'Beperk de bestandstypes tot afbeeldingen
End With
.FilterIndex = 1
.AllowMultiSelect = False 'Slechts ??n bestand kiezen toegestaan
.InitialView = 1 'Bepaal weergave
If .show = -1 Then 'Bepaal of gebruiker op OK-knop heeft geklikt.
sFile = .SelectedItems(1) 'Source file wordt gevuld met geselecteerde bestand
Else
MsgBox "De bijlage is niet opgeslagen!"
BestandOpzoeken = "Annuleren"
GoTo Hell 'Reset keuzemenu
End If
End With
BestandOpzoeken = sFile '1 C:\Users\mail\Documents\Doc2.pdf
Hell:
Set dlgPicker = Nothing 'Reset keuzemenu
End Function
Waarom gaat het fout? Er wordt in de tabel alleen maar een bestandsnaam opgeslagen. Moet Bijlage1 nog worden gedeclareerd? Zou een Error Resume Next helpen boven de foutregel, wat doet dan On Error GoTo Hell??