Bestanden opslaan buiten database

Status
Niet open voor verdere reacties.

neilvv

Gebruiker
Lid geworden
27 mei 2015
Berichten
47
Graag wil ik bij een klantenbestand de mogelijkheid hebben om div bijlages op te slaan maar wil dit niet in de database maar in een eigen gekozen path dit om de database niet te groot te laten worden en om ook buitenom de database de bestanden te kunnen open.

Nu heb ik iets gevonden wat daar denk ik (na wat aanpassingen) wel aan kan voldoen, alleen krijg ik het niet voor elkaar om een variable (CustomerID) toe te voegen aan het path, zodat de bestanden van alleen die klant zichtbaar worden.
Heeft iemand een idee hoe ik dat moet doen?

Of heeft iemand een beter idee/voorbeeld om dit voor elkaar te krijgen?

bvdBekijk bijlage Browsing.zip
 
Ik ben het helemaal eens met je uitgangspunt dat bijlagen niet in een db thuishoren, en het bij-argument dat je de bestanden ook buiten de database kan blijven gebruiken en bewerken vind ik minstens zo belangrijk. Kortom: ik gebruik dezelfde techniek, maar dan met een andere uitvoering. Ik gebruik een functie die automatisch bij het bladeren door de personentabel (uiteraard via een formulier) een map aanmaakt voor de personen, zodat de gebruiker daar zelf geen omkijken naar heeft. Die code ziet er zo uit:
Code:
    With Me
        TempVars("varPersoonID").Value = Me.persoon_id.Value
        If IsNull(.PersoonPad) And TempVars("varPersoonPad").Value & "" = "" Then
            TempVars("varPersoonPad").Value = fPadMaken(Stam_Pad & "\Personen\" & TempVars("varPersoonID").Value & "\")
            .PersoonPad.Value = TempVars("varPersoonPad").Value
            .Dirty = False
        Else
            TempVars("varPersoonPad").Value = .PersoonPad.Value
        End If
    End With

De functie fPadMaken komt zo :). Eerst even de rest van de procedure uitleggen. Dat pad wordt dus opgeslagen in de personentabel en in die tabel staan bij mij dan 3 tesktvakken voor 3 vaste documenten (IDkaart, CV etc). Die worden met een FileDialog opgehaald.

Code:
Private Sub cv_DblClick(Cancel As Integer)
Dim sFile As String, sDoc As Variant
    
    On Error GoTo Hell
    If Me.kopie_cv & "" = "" Then
        sFile = BestandOpzoeken
        If sFile = "Annuleren" Then Exit Sub
        If Not Dir(sFile) = "" Then
            If InStr(1, sFile, "\") = 0 Then Exit Sub
            sDoc = Split(sFile, "\")
            Me.kopie_cv = sDoc(UBound(sDoc))
            On Error Resume Next
            FileCopy sFile, Me.DossierPad & "\" & sDoc(UBound(sDoc))
            Me.Repaint
        End If
    Else
        Application.FollowHyperlink Me.DossierPad & Me.kopie_cv
    End If
    Exit Sub

Hell:
    If MsgBox("Het bestand '" & LCase(Me.kopie_cv) & "' ontbreekt in de personenmap; wil je het verwijderen uit de lijst?", vbYesNo) = vbYes Then
        Me.cv = Null
    End If

End Sub
Ook hier een functie (BestandOpzoeken) die ik zo laat zien :). Het tekstvak dat de bestandsnaam laat zien wordt dus tweeledig gebruikt: als het leeg is, kun je met een functie een bestand invullen. Is het veld gevuld, dan wordt met een dubbelklik het document geopend.

Dan nu de 2 functies.

Code:
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

Code:
Public Function GetPathOnly(sPath As String) As String
    GetPathOnly = Left(sPath, InStrRev(sPath, "\", Len(sPath)) - 1)
End Function

Deze functie(s) maakt het pad aan op basis van de aangeleverde string. Zoals je in de eerste code kunt zien, zit in het vraagpad ook een PersoonID. Kun je uiteraard simpel uit je formulier opvragen.
De tweede functie zoekt het bestand op. Die ziet er dan zo uit:

Code:
Function BestandOpzoeken(Optional Pad As String) As String
Dim dlgPicker As FileDialog
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 = CurrentProject.Path Else: sPad = Pad
    If Right(sPad, 1) <> "\" Then sPad = sPad & "\"
    Set dlgPicker = Application.FileDialog(msoFileDialogFilePicker)
    With dlgPicker
        .Title = "Selecteer een bestand." 'De titel voor het venster
        .InitialFileName = sPad      'Waar moet het venster beginnen?
        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 = msoFileDialogViewList        'Bepaal weergave
        If .Show = -1 Then                          'Bepaal of gebruiker op OK-knop heeft geklikt.
            sFile = .SelectedItems(1)           'String wordt gevuld met geselecteerde bestand
        Else
            MsgBox "Er is op <Annuleren> gedrukt..."
            BestandOpzoeken = "Annuleren"
            GoTo Hell
        End If
    End With
    BestandOpzoeken = sFile
    
Hell:
    Set dlgPicker = Nothing

End Function

Hier kun je zelf denk ik wel verder aan sleutelen als het bruikbaar is :).
 
Bedankt Octafish,

Hier ga ik mee aan de slag en zien te passen naar m'n eigen omgeving!
 
Zoals je ziet gebruik ik ook TempVars; die heb je niet nodig voor de functie, maar in mijn geval dus wel, daarom heb ik ze maar laten staan in de code. Maar die regels kunnen er dus uit als je geen TempVars gebruikt. Dan kun je de bestandsnaam gelijk in het tekstveld zetten. Als je er niet uitkomt : ik zie de vragen wel verschijnen :).
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan