Listbox vullen met bestanden uit een folder werkt niet meer.

Status
Niet open voor verdere reacties.
Om de .Net Frame 3.5 in te schakelen heb je admin rechten nodig en die heb ik niet. Ik heb dit nu aangevraagd aan de admin, maar dit is bij een extern bedrijf en dit kan even duren.

Als ik de code uit #7 gebruik, werkt de Userform correct.
Maar in deze code zit ik met het probleem sorteren, nieuwer naar ouder en niet alfabetisch.

JEC, heeft een code #8 geschreven om alles (inladen en sorteren) in een keer in te laden. Waarschijnlijk om deze code te laten werken heb ik .Net Frame 3.5 nodig zoals HSV aangeeft.
 
Hou het dan zo simpel mogelijk:

Code: 
Private Sub Userform_Initialize()
   Listbox3.List = Split(createobject("wscript.shell").Exec("cmd /c Dir ""C:\Users\LucBr\Sk\BRU_HRS_Int_Team - DISPATCH HRS\LOGBOEKEN\Scan\*.pdf"" /b/on").stdout.readall, vbCrLf)
End Sub

Terzijde: vermijd immer spaties in namen van bestanden en folders/paden.
 
Laatst bewerkt:
Hier nog een andere sorteer methode.


Maar naar het schijnt wordt het direct gesorteerd binnengehaald.
Vandaar de sortering als opmerking geschreven.
Code: 
Private Sub UserForm_Initialize()
Dim xp, it, i As Long, j As Long, tmp
ReDim a(0)
xp = "[COLOR=#3E3E3E]C:\Users\LucBr\Sk\BRU_HRS_Int_Team - DISPATCH HRS\LOGBOEKEN\Scan\[/COLOR]"
For Each it In CreateObject("scripting.filesystemobject").getfolder(xp).Files
    If it.Name Like "*.pdf" Then
     a(UBound(a)) = it.Name
     ReDim Preserve a(UBound(a) + 1)
End If
Next
'For i = LBound(a) To UBound(a) - 1
'   For j = i + 1 To UBound(a) - 1
'        If a(i) > a(j) Then
'            tmp = a(j)
'            a(j) = a(i)
'            a(i) = tmp
'        End If
'    Next j
'Next i
ListBox1.List = a
End Sub
 
Laatst bewerkt:
@snb

Volgende krijg ik:
Acces is denied. Fout tijdens uitvoering 2147024891 (80070005)
 
@HSV

Jouw code opent netjes de ListBox met de PDF bestanden, dus hier geen probleem met .Net Framework 3.5. Dit is al zeer tof.

Maar of ik de code draai zonder of met de sortering, ik krijg hetzelfde te zien, alfabetische sortering.
De file Scan, waarnaar wordt verwezen op SharePoint is op zich fix gesorteerd volgens nieuw naar oud, dus nieuwste bovenaan in de lijst.
 
Dat is ook zo, vroeger als we nog met een lokale server werkten, werkte alles zonder problemen. Maar nu controleren en blokkeren ze veel zaken. Daarom ben ik op zoek naar een alternatief dat volgens de nieuwe veiligheidspolicy wel werkt. Niet eenvoudig.
De code van HSV #25 werkt, alleen de sortering is nog altijd alfabetisch. Nieuwste bestand in de map zou bovenaan moeten staan.
Ik hoop een beetje dat jullie experten het alsnog opgelost krijgen.
 
In onderstaande code wordt het gesorteerd op de aangemaakte datum (datecreated).

Code: 
Private Sub UserForm_Initialize()
Dim xp, it, i As Long, j As Long, tmp
ReDim a(0)
xp = [COLOR=#333333]"[/COLOR][COLOR=#3E3E3E]C:\Users\LucBr\Sk\BRU_HRS_Int_Team - DISPATCH HRS\LOGBOEKEN\Scan\[/COLOR][COLOR=#333333]"[/COLOR]
With CreateObject("scripting.filesystemobject")
For Each it In .getfolder(xp).Files
    If it.Type = "Adobe Acrobat-document" Then
     a(UBound(a)) = it.Name
     ReDim Preserve a(UBound(a) + 1)
End If
Next
  For i = LBound(a) To UBound(a) - 1
   For j = i + 1 To UBound(a) - 1
        If .getfile(xp & a(i)).datecreated > .getfile(xp & a(j)).datecreated Then
            tmp = a(j)
            a(j) = a(i)
            a(i) = tmp
        End If
    Next j
Next i
End With
ListBox1.List = a
End Sub
 
Code: 
Private Sub Userform_initialize()
  c00 = "G:\OF\"
  c01 = Dir(c00 & "*.PDF")
   
  With CreateObject("ADODB.recordset")
    .Fields.Append "bestand", 129, 120
    .Fields.Append "datum", 7
    .Open
   
    Do Until c01 = ""
      .AddNew
      .Fields("bestand") = c01
      .Fields("datum") = FileDateTime(c00 & c01)
      .Update
      c01 = Dir
    Loop
    .Sort = "datum desc"
    
    Listbox3.columns = .GetRows
  End With
End Sub

Zie: https://www.snb-vba.eu/VBA_ADODB_recordset.html#L_0
 
Om terug te komen op het begin van deze draad:
- je hebt geen Useerform nodig met application.filedialog
- het application.filedialog scherm kun je op allerlei manieren sorteren met 1 klik
- application.filedialog doet precies (en meer) wat je nu met eigen code wil maken
- systeembeheer kan application.filedialog niet uitschakelen.

Mij lijkt het simpelst (vervang het pad van initialfilename door jullie sharepointadres)

Code: 
Sub M_snb()
  With Application.FileDialog(3)
     .InitialView = 2
     .InitialFileName = "G:\OF\*.pdf"
     If .Show Then ActiveCell.Hyperlinks.Add ActiveCell, .SelectedItems(1), , .SelectedItems(1), .SelectedItems(1)
  End With
End Sub
 
Laatst bewerkt:
@HSV,

ListBox3 opent normaal maar deze blijft leeg. Geen enkel PDF bestand wordt weergegeven.
 
@ snb,

Jouw eerste code uit Post #31 .Columns aangepast naar .Column, na het lezen van de bijgevoegde link.
Sortering werkt nu op datum aanmaak, nieuwer naar ouder.
Dit werkt volledig.:thumb:

Post #32 is inderdaad het begin van deze draad: Dit is inderdaad de simpelste manier. Ik krijg de lijst op SharePoint te zien, maar bij het aanklikken van een bestand om een hyperlink te creëren krijg ik fout 400. M.a.w. als ik in de actieve cel de hyperlink wil creëren, krijg ik fout 400.
Ik heb een afbeelding van hoe de lijst eruit ziet na openen.
 

Bijlagen

  • Afbeelding1.jpg
    Afbeelding1.jpg
    38,8 KB · Weergaven: 15
Wat krijg je retour als je een msgbox plaatst met, msgbox it.type

Zet anders weer de coderegel terug met de like "*.pdf" methode.
 
Wart is dan het resultaat hiervan ?

Code: 
Sub M_snb()
  With Application.FileDialog(3)
     .InitialView = 2
     .InitialFileName = "G:\OF\*.pdf"
     If .Show Then Msgbox .SelectedItems(1)
  End With
End Sub
 
@ HSV

Met *.PDF methode krijg ik een ongeldige verwijzing.
Met een Msgbox krijg ik een Msgbox, maar die is ook leeg, geen opmerking.
 
@ snb

Het resultaat van de msgbox is het volledige pad naar het bestand dat ik selecteerde. Verder geen fout.
 
Test eens:

Code: 
Sub M_snb()
  With Application.FileDialog(3)
     .InitialView = 2
     .InitialFileName = "G:\OF\*.pdf"
     If .Show Then ActiveCell.Hyperlinks.Add ActiveCell, .SelectedItems(1)
  End With
End Sub
 
Laatst bewerkt:
Dan de volledige aangepaste code maar.
Code: 
Private Sub UserForm_Initialize()
Dim xp, it, i As Long, j As Long, tmp
ReDim a(0)
xp = "C:\Users\LucBr\Sk\BRU_HRS_Int_Team - DISPATCH HRS\LOGBOEKEN\Scan\"
With CreateObject("scripting.filesystemobject")
For Each it In .getfolder(xp).Files
    If it.Name Like "*.pdf" Then
     a(UBound(a)) = it.Name
     ReDim Preserve a(UBound(a) + 1)
End If
Next
  For i = LBound(a) To UBound(a) - 1
   For j = i + 1 To UBound(a) - 1
        If .getfile(xp & a(i)).datecreated < .getfile(xp & a(j)).datecreated Then
            tmp = a(j)
            a(j) = a(i)
            a(i) = tmp
        End If
    Next j
Next i
End With
ListBox1.List = a
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan