gekaapte excel bestanden

Georgyboy · 31 dec 2020

Dankjewel voor de vraag Evelthoven,

Dank voor de mooie leerzame oplossingen HSV !, Jveer, gld19

Ik heb echter nog een vraag als dit kan en mag?
Wat doe ik verkeerd en waarom?

Het is zo leerrijk en knap wat jullie kunnen ! Dank dat we dit steeds mogen leren van jullie

Dit lukt

Code:

Sub hsv()
Dim a, cl As Range
a = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\.........\Documents\.........\*.xls""/b/o:d/s").stdout.readall, vbCrLf) 'incl. bestanden in onderliggende mappen door /s
Cells(1).Resize(UBound(a)) = Application.Transpose(a)
For Each cl In Cells(1).CurrentRegion
  ActiveSheet.Hyperlinks.Add cl, cl.Text, , , cl.Text
Next cl
End Sub

Hier loopt het vast

In blad 1 een tabel gemaakt "Bestanden" bereik A1:B3

Code:

Sub hsv()
Dim a, cl As Range
a = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\..........\documents\........\excelbes\*.xls""/b/o:n/s").stdout.readall, vbCrLf) 'incl. bestanden in onderliggende mappen door /s + gesorteerd A_Z  door o:n
[COLOR="#FF0000"]With ActiveSheet.ListObjects("bestanden")[/COLOR][HTML]'" ook met "With ActiveSheet.ListObjects(1)"[/HTML]
 If .ListRows.Count > 0 Then .DataBodyRange.Delete
  .ListRows.Add.Range.Resize(UBound(a), 1) = Application.Transpose(a)
     For Each cl In .ListColumns(1).DataBodyRange
       .Parent.Hyperlinks.Add cl, cl.Text, , , cl.Text
       cl.Offset(, 1) = FileDateTime(cl)
     Next cl
End With
End Sub

Hier loopt het ook vast

Code:

Sub hsv4()
Dim a, cl As Range
a = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\..........\documents\...........\excelbes\*.xls""/b/o:n/s").stdout.readall, vbCrLf) 'incl. bestanden in onderliggende mappen door /s + gesorteerd
[COLOR="#FF0000"]Cells(1).Resize(UBound(a)) = Application.Transpose(a)[/COLOR]
  For Each cl In Cells(1).CurrentRegion.Columns(1).SpecialCells(2)
     ActiveSheet.Hyperlinks.Add cl, cl.Text, , , cl.Text
    cl.Offset(, 1) = FileDateTime(cl)
  Next cl

End Sub

Hartelijk dank aan allen voor de vragen en oplossingen dat we mogen leren,

Fijn eindejaar en een zéér gezond en leuk 2021 !

Evelthoven · 31 dec 2020

Ik ben supertevreden. Iedereen bedankt.

cow18 · 1 jan 2021

@georgyboy,
De transpose niet wil lukken, dat kan door :
- of het aantal bestanden is vrij hoog zonder dat ik daar een duidelijke grens kan op zetten (>20.000 ?)
- of 1 of meerdere van je files "C:\users\....." is te lang en ik vermoed langer dan 255 karakters, dat zou kunnen opgelost worden door het path te verwijderen uit je array, maar dan kan je in een volgende stap geen hyperlink meer maken. 2e optie zou dan kunnen zijn, de transpose zelf te maken in de macro ipv. het transpose-commando.
- of nog een andere reden.

ik gok op 2.
Zet anders eens voor die rode regel

Code:

msgbox ubound(a)

Georgyboy · 1 jan 2021

@Cow18

Dank om verder te zoeken

Code:

- of het aantal bestanden is vrij hoog zonder dat ik daar een duidelijke grens kan op zetten (>20.000 ?)

Totaal bestanden kleine 1500

Path lengte 1 bestand met lengte 249 karakters

Zonder : "excelbes" lukt de eerste kolom

Code:

\documents\........\excelbes\*.xls"

blijft vast in 2° kolom (tijd) na 14 regels

Code:

msgbox ubound(a)

Fout Compileerfout Syntaxisfout verwacht instructie-einde

Alvast bedankt

cow18 · 1 jan 2021

met deze zou je over de grens van de 255 karakters kunnen gaan, doordat je zelf transponeert.
De fout na de 14e regel, inspecteer eens de naam van die file, daar staat iets geks in, een teken als %#\;: en aanverwanten.
Nu gaat de macro niet meer in de fout, maar naast die gekke naam zal je geen tijdstip zien verschijnen.

Code:

Sub hsv4()
   Dim a, cl   As Range, arr()
   mijnpath = "C:\Users\..........\documents\...........\excelbes\"   '--->jouw path
   mijnpath = ThisWorkbook.Path & "\oude files\"   '--->mijn path, gooi straks deze regel weg

   a = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & mijnpath & """*.xls/b/o:n/s").stdout.readall, vbCrLf)   'incl. bestanden in onderliggende mappen door /s + gesorteerd
   If UBound(a) = -1 Then MsgBox "foutje bedankt": Exit Sub
   ReDim arr(UBound(a), 0)                       'array herdimensioneren naargelang omvang van andere
   For i = 0 To UBound(a): arr(i, 0) = a(i): Next   'zelf transporeren
   Cells(1).Resize(UBound(a)) = arr              'getransponeerde array gebruiken

   On Error Resume Next                          'doorgaan als je een te gekke filename tegen komt (naam bevat bepaalde speciale karakters)
   For Each cl In Cells(1).CurrentRegion.Columns(1).SpecialCells(2)
      ActiveSheet.Hyperlinks.Add cl, cl.Text, , , cl.Text
      cl.Offset(, 1) = FileDateTime(cl)
   Next cl
   cells(1).entirecolumn.autofit

End Sub

Enigmasmurf · 2 jan 2021

de naam van die file, daar staat iets geks in, een teken als %#\;: en aanverwanten

Ik denk dat het niet eens zó gek moet zijn. Ook met karakters als é, ë... kan het fout gaan.
Bij Shell in combinatie met Exec is het namelijk niet mogelijk om "cmd /c Dir" uit te breiden naar "cmd /c /u Dir".
Dat lukt wel als je Run gebruikt, maar dat impliceert natuurlijk een omweg via een tekstbestand.
Kiezen of delen dus.
Al hoop ik natuurlijk altijd dat iemand me tegenspreekt en er toch een briljante manier uit de bus valt

Georgyboy · 2 jan 2021

Vooreerst beste wensen en een goede gezondheid voor 2021!

@Cow18
Bedankt voor de zéér leerrijke info, heb er weer van geleerd

Jouw info heeft me verder geholpen en hoop ook anderen.

Alles werkt perfect heb nu dubbel zoveel Excel bestanden (2960)
Daar waar in de 2° kolom geen datum komt is er een fout in de patch, deze kan ik ook niet openen.
Door de map of bestandsnaam correct te schrijven lukt het wel.

Foute schrijfwijze zoals je had aangegeven
Vb. : Programma´s (´) | 2° (°) | Aperïo | (Ï) etc

Door deze juist te schrijven werkt het perfect en kan het via de link worden geopend.

Dit leert me om een map of bestand correct op te slaan voor latere fouten te vermijden.

Hartelijk dank aan de vraagsteller Evelthoven
Alsook voor de geboden oplossingen!

Bedankt Cow18 voor je zéér nuttige uitleg en oplossing

:thumb:

Groeten,
Georgyboy

Georgyboy · 2 jan 2021

Dank ook Enigmasmurf, we waren gelijk bezig

pixcel · 2 jan 2021

Fijn dat iedereen happy is. Maar anno 2021 zou bij dit soort vragen een oplossing via Gegevens ophalen > Uit map toch niet mogen ontbreken. Zonder vba typewerk en met enkele muisklikken haal je er bovendien meer uit.
In bijlage: pas op Blad1 de waarde van Doelmap aan en kies Gegevens > Alles vernieuwen (Alt-Ctrl-F5).
Dit is de m-code van de query Bestanden die de Power Query Editor voor je genereert:

Code:

let
    Source = Folder.Files(Doelmap),
    #"Removed Columns" = Table.RemoveColumns(Source,{"Content"}),
    #"Reordered Columns" = Table.ReorderColumns(#"Removed Columns",{"Folder Path", "Name", "Extension", "Date accessed", "Date modified", "Date created", "Attributes"}),
    #"Expanded Attributes" = Table.ExpandRecordColumn(#"Reordered Columns", "Attributes", {"Content Type", "Kind", "Size", "ReadOnly", "Hidden", "System", "Directory", "Archive", "Device", "Normal", "Temporary", "SparseFile", "ReparsePoint", "Compressed", "Offline", "NotContentIndexed", "Encrypted", "ChangeTime", "SymbolicLink", "MountPoint"}, {"Content Type", "Kind", "Size", "ReadOnly", "Hidden", "System", "Directory", "Archive", "Device", "Normal", "Temporary", "SparseFile", "ReparsePoint", "Compressed", "Offline", "NotContentIndexed", "Encrypted", "ChangeTime", "SymbolicLink", "MountPoint"}),
    #"Filtered Rows" = Table.SelectRows(#"Expanded Attributes", each Text.Contains([Content Type], "excel"))
in
    #"Filtered Rows"

snb · 2 jan 2021

Enigmasmurf zei:
Ik denk dat het niet eens zó gek moet zijn. Ook met karakters als é, ë... kan het fout gaan.
Bij Shell in combinatie met Exec is het namelijk niet mogelijk om "cmd /c Dir" uit te breiden naar "cmd /c /u Dir".
Dat lukt wel als je Run gebruikt, maar dat impliceert natuurlijk een omweg via een tekstbestand.
Kiezen of delen dus.
Al hoop ik natuurlijk altijd dat iemand me tegenspreekt en er toch een briljante manier uit de bus valt

Daag me niet uit.
Hoewel ik geen API-liefhebber ben:

Code:

Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
       
Public Function F_ASC_ANS(ByVal Text As String) As String
  OemToCharA Text, Text
  F_ASC_ANS = Text
End Function

Sub M_snb()
   MsgBox F_ASC_ANS(CreateObject("wscript.shell").exec("cmd /c Dir ""J:\download\*.*"" /b/a-d/s").StdOut.readall)
End Sub

Georgyboy · 2 jan 2021

Beste SNB

Bedankt Voor Uw code, probeer deze ook te begrijpen, maar begrijp deze (nog)niet
Wellicht doe ik wat fout

Heb de code volledig in een module geplaatst, bij uitvoeren "Sub M_snb() verschijnt een pop-up excel met OK om af te sluiten of op het kruisje afsluiten

Code:

Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
       
Public Function F_ASC_ANS(ByVal Text As String) As String
  OemToCharA Text, Text
  F_ASC_ANS = Text
End Function

Sub M_snb()
   MsgBox F_ASC_ANS(CreateObject("wscript.shell").exec("cmd /c Dir ""J:\download\*.*"" /b/a-d/s").StdOut.readall)
End Sub

Deze ook even aangepast maar pop-up blijft "excel"

Code:

c Dir ""[COLOR="#FF0000"]C[/COLOR]:\G.........\doc......\G.........\*.*"" /

Alvast bedankt
Georgyboy

Enigmasmurf · 2 jan 2021

@ snb,

Uitdagen? Ik zou niet durven, of beter gezegd: ik zou wél durven, maar 't is mijn stijl niet.
En 'stimuleren' is dan weer net dat ietsje té zacht uitgedrukt... 'uit je kot lokken' dan maar ?

@ Georgyboy,

Die pop-up is natuurlijk het logische gevolg van de ene instructie in snb's sub (MsgBox = MessageBox).
Daarmee is enkel aangetoond dat het unicode-issue waar ik eerder op wees kan omzeild worden (met een beetje API-voorbehoud).

Als jij iets anders met het resultaat wil zal de gepaste code moeten voorzien worden. Ik zou verwachten dat je die uit je voorgaande code kan puzzelen...

puppie · 2 jan 2021

Ik zie dat dit topic gekaapt is door georgyboy, dat is niet de bedoeling je kunt ook een vraag stellen met een verwijzing naar dit topic.
Ik ga vanavond dit onderwerp splitsen zodat het een eigen vraag gaat worden.

Georgyboy · 3 jan 2021

Mijn excuses voor het ongemak ! bedankt voor de mogelijkheid "je kunt ook een vraag stellen met een verwijzing naar dit topic"
Hopelijk nemen jullie mij niet kwalijk voor die fout?

Groeten,
Georgyboy

snb · 3 jan 2021

@georgy

Dat valt wel mee.
Enigmasmurf attendeerde terecht op de beperking van de aangereikte shell commando methode: diakritische tekens worden niet goed weergegeven.
Die beperking is ook van toepassing op de suggestie die Evelthoven heeft gekregen. Evelthoven zal daar vroeger of later ook achterkomen.
Zijn/haar tevredenheid zal dan ook dienovereenkomstig wijzigen.
Voor de volledigheid van haar/zijn draad is de kanttekening van Enigmasmurf ook relevant. Dat geldt ook voor de suggesties die te berde worden gebracht om de beperkingen van de methode te ondervangen.
De 'tevredenheid' van Evelthoven is prima, maar de vasthoudendheid van anderen om het thema uit te diepen noem ik geen 'kapen', maar zinvolle verdieping en completering van het aangesneden thema. Als je je realiseert dat de meeste draden pas informatief zijn voor alle bezoekers na dit tijdstip zijn er nu nu 2 onvolledige themadraden gecreëerd. Ze hadden beter ongesplitst kunnen blijven.

over de code:
Ik kan niet zien of zich op die plaats wel bestanden bevinden.

Georgyboy · 3 jan 2021

Beste snb

Wat is dit weer leerrijk

1) Jouw volledige code heb ik in een module geplaatst, is dit ok zo ?
2) De dir aangepast wat werkt bij vorige test van HSV

Opgeslagen Functie

Resultaat een venster met een gedeelte van alle bestanden
Via M_snb() of via klikken op de functie

Groeten,
Georgyboy

snb · 3 jan 2021

Omdat de msgbox slechts een beperkt aantal tekens kan tonen zie je niet alles.

als je alles wil zien, bijv (1 van de ~74 methoden):

Code:

Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
       
Public Function F_ASC_ANS(ByVal Text As String) As String
  OemToCharA Text, Text
  F_ASC_ANS = Text
End Function

Sub M_snb()
   sn= split(F_ASC_ANS(CreateObject("wscript.shell").exec("cmd /c Dir ""J:\download\*.*"" /b/a-d/s").StdOut.readall),vbcrlf)
   for each it in sn
      msgbox it
   next
End Sub

VenA · 3 jan 2021

@puppie, Wie heeft de titel van dit draadje bedacht? Ik denk ook niet dat #2 in dit draadje past.

gekaapte excel bestanden

Gebruiker

Bijlagen

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Bijlagen

Verenigingslid

Gebruiker

Gebruiker

Supermoderator

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Inventaris

Wij waarderen jouw privacy