Vaste locatie van afbeeldingen, verschillende driveletters

[ExcelTonnie]

Via een programma haal ik foto's op vanwege incidenten.
Dit programma staat op een netwerk waar diverse gebruikers toegang toe hebben.
Het volgende probleem doet zich voor dat bepaalde mensen alleen de foto's zien en anderen weer niet.
De locatie is overal hetzelfde alleen het probleem is dat sommigen dezelfde locatietoegang hebben alleen de driveletter verschil per computer.
Hoe kan ik dit omzeilen in mijn verwijzing.
Al de locatie dus niet bestaat er op een andere lacatie (drive) gezocht wordt.

Private Sub ZoekFotos(Dossier)
    lstFotos.Clear
    Dim foto As String
'    Onderstaand is de locatie van je afbeeldingen
    foto = Dir("S:\Incidenten\Pictures\" & Dossier & "*.jpg")

     'foto = Dir("K:\Incidenten\Pictures\" & Dossier & "*.jpg")
       'foto = Dir("Q:\Incidenten\Pictures\" & Dossier & "*.jpg")

    Do Until foto = ""
        Me.lstFotos.AddItem foto
        foto = Dir
    Loop
    If lstFotos.ListCount > 0 Then
        lstFotos.ListIndex = 0
        ToonFoto
    End If
End Sub

 

[edmoor]

Zoiets:

Private Sub ZoekFotos(Dossier)
    Dim fso As Object
    Dim foto As String
    Dim Schijf As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.DriveExists("K") Then Schijf = "K:"
    If fso.DriveExists("Q") Then Schijf = "Q:"
    If fso.DriveExists("S") Then Schijf = "S:"

    If Schijf = "" Then
        MsgBox "Geen van de schijven K, Q en S gevonden.", vbCritical, "Geen schijf"
        Exit Sub
    End If
    
    lstFotos.Clear

    [COLOR="#008000"]'Onderstaand is de locatie van je afbeeldingen[/COLOR]
    foto = Dir(Schijf & "\Incidenten\Pictures\" & Dossier & "*.jpg")
    Do Until foto = ""
        Me.lstFotos.AddItem foto
        foto = Dir
    Loop
    
    If lstFotos.ListCount > 0 Then
        lstFotos.ListIndex = 0
        ToonFoto
    End If
End Sub

 

[snb]

Sub M_ZoekFotos(Dossier)
  c00 = ":\Incidenten\Pictures\" & Dossier & "*.jpg"

  for j = 1 to 3
    c01 =  Dir(mid("SKQ",j,1) & c00)
    if c01 <> "" then exit for
  next 

  Do Until c01 = ""
    c02 = c02 & vblf & c01
    c01 = Dir
  Loop

  if c02 <> "" then lstFotos.List = split(c02,vblf)
End Sub

 

[ExcelTonnie]

Helaas kom ik er niet uit met behulp van jullie code.
Waarschijnlijk omdat niet het hele verhaal/code kennen.
Hier dan alsnog een deel van het progje.

 

[edmoor]

Je vroeg naar een manier om te controleren of een schijf er is ja of nee.
Die heb ik je gegeven.

 

[ExcelTonnie]

edmoor,

dat klopt helemaal echter kom ik niet verder met mijn code zoals ik dit voor ogen had.
vandaar dan toch maar meer in detail gekomen.

 

[snb]

Het lijkt me beter de vraag duidelijker te formuleren.

 

[ExcelTonnie]

Het programmatje is een deel van een groter programma.

Deze staat op het netwerk waar diverse afdelingen toegang toe hebben.
De afbeeldingen die hiermee te maken hebben staan in de submap Pictures.
In de code laat ik hierna verwijzen en vanaf mijn locatie werkt het prima.
Echter vanaf sommige andere locaties werkt het niet omdat bij andere gebruikers de driveletter niet overeenkomt met de verwijzing.
Per gebruiker kan ik niet hun driveletter gaan aanpassen omdat ik hier geen rechten over heb.
De code moet dus zo zijn dat die check op deze locatie en wanneer deze niet bestaat deze dan kijkt bij een andere schijf.
Ben nu aan het inventariseren welke gebruiker welke driveletter gebruikt.

 

[edmoor]

Dat is precies wat mijn voorbeeld doet.

 

[ExcelTonnie]

Dat is precies wat mijn voorbeeld doet.

dit heb ik getest maar toont geen afbeeldingen bij mij.
bij jou wel?

 

[edmoor]

Daar gaat het ook niet om.
Het gaat om het ophalen van de juiste driveletter.
Dan moet je natuurlijk wel even controleren hij de juiste gekozen is.

 

[alphamax]

Gebruik UNC paden.

 

[snb]

In jouw code zal

 Me.lstFotos.AddItem foto

nooit een foto tonen; slecht de fullname van een jpg-afbeelding.

 

[ExcelTonnie]

Sorry maar kom hier niet mee verder, de code zoals ik hem heb werkt verder prima.
Echter mensen die een andere driveletter hebben krijgen de foto's niet te zien.
Dit wilde ik opgelost hebben maar kan het ook niet anders uitleggen.

 

[snb]

Uit niets blijkt dat je iets met de suggestie in #3 gedaan hebt.

Hier dan een panklare oplossing:

 

[ExcelTonnie]

SNB

Jazeker heb ik wel een en ander geprobeerd maar ben nog niet zo volleerd als jullie experts.
Snap ook wel waarom jullie zo cryptisch blijven antwoorden. (jullie proberen waarschijnlijk de mensen zo meer zelf te laten nadenken.)
In jou geval ben ik nog eens gaan kijken naar de code wat er nu zou moeten werken.
Wat ik over het hoofd had gezien, jou code overgenomen en zag niet de M_ en moest dit ook aanpassen in de andere code.
Ga de code nog eens stap voor stap aandachtig bestuderen.
Bedankt tot zover.

 

[snb]

Zie #14 met bijlage

 

[ExcelTonnie]

SNB


Zolang de afbeeldingen op H staan is het ok.
Maar in de Sub staat ook nog steeds de code verwijzing naar de H.
Wanneer dus een gebruiker niet H heeft maar T dan wordt er dus niets getoont, logisch maar hoe verwijs ik daar naar.

Private Sub ToonFoto()


'   Onderstaand moet de locatie van de foto's zijn
     img = "H:\HelpMij\Pictures\" & lstFotos.List(lstFotos.ListIndex)

    Me.Image1.Picture = LoadPicture(img)
    Me.Repaint
End Sub




Sub M_ZoekFotos(Dossier)
  c00 = ":\Helpmij\Pictures\" & Dossier & "*.jpg"

  For j = 1 To 4
    c01 = Dir(Mid("CKTH", j, 1) & c00)
    If c01 <> "" Then Exit For
  Next

  Do Until c01 = ""
    c02 = c02 & vbLf & c01
    c01 = Dir
  Loop

  If c02 <> "" Then lstFotos.List = Split(c02, vbLf)
End Sub

 

[snb]

Open de bijlage in #14

 

[ExcelTonnie]

snb

Code in bijlage werkt niet.

Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub



Private Sub UserForm_Initialize()
  C_00.List = Blad1.Cells(1).CurrentRegion.Value
  
  With CreateObject("scripting.filesystemobject")
     For Each It In .drives
       C_00.Tag = C_00.Tag & It.driveletter
     Next
  End With
End Sub
Private Sub C_00_Change()
   If C_00.ListIndex > -1 Then
    c00 = ":\Helpmij\Pictures\" & C_00 & "*.jpg"
    If C_00.Column(1) = "Ja" Then
       For j = 1 To Len(C_00.Tag)
         c01 = Dir(Mid(C_00.Tag, j, 1) & c00)
         If c01 <> "" Then Exit For
       Next
       If c01 <> "" Then Image1.Picture = LoadPicture(c01)
    End If
   End If
End Sub