Met de LIFO methode bestand uit map halen

[Leondemooij]

Hallo,

Ik doe simpele bewerkingen aan foto's in Excel.
Nu kan ik met vba simpel een foto uit een map halen met de bekende bestandsnaam.
Maar in deze situatie moet ik de laatste foto [bestand] hebben wat er in de map bijgekomen is.
Kan ik met Excel de map monitoren en in de gaten houden welk bestand er als laatste bijgekomen is ?
De bestandsnaam wordt automatisch door de foto camera aangemaakt.

Groeten Leon de Mooij

 

[edmoor]

Dat kan met deze functie:

Function GetLastCreatedFile(Pad As String) As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set List = CreateObject("ADOR.Recordset")
    
    List.Fields.Append "name", 200, 255
    List.Fields.Append "date", 7
    List.Open
    
    For Each f In fso.GetFolder(Pad).Files
      List.AddNew
      List("name").Value = f.Path
      List("date").Value = f.DateLastModified
      List.Update
    Next

    List.Sort = "date DESC"
    List.MoveFirst

    GetLastCreatedFile = List("name")
    List.Close
End Function

 

[snb]

of zo:

sub M_snb()
  msgbox split(createobject("wscript.shell").exec("cmd /c dir G:\OF\*.jpg /b/o-d").stdout.readall,vbcrlf)(0)
End Sub

 

[edmoor]

Hij is weer mooi
De -d was dus de truuk.
Ik kreeg telkens de oudste eerst.

 

[Leondemooij]

Even voor de duidelijkheid, en dat ik het ook snap.
Dit is nu de code:

Sub DrawPicture()

    Dim ws As Worksheet, s As Shape
    Set ws = ActiveSheet
    ' Insert the image.
    Set s = ws.Shapes.AddPicture("D:\test fotos veiling\origineel.JPG", _
      False, True, 100, 100, 1, 1)
    ' Use picture's height and width.
    s.ScaleHeight 1, msoCTrue
    s.ScaleWidth 1, msoCTrue
    ActiveSheet.Pictures.Select
    
    Call Uitsnijden
    
End Sub

Waar zet ik dan dat stukje code van SNB ?

 

[edmoor]

Zoiets:

Sub DrawPicture()
    Dim ws As Worksheet, s As Shape, Foto As String
    Set ws = ActiveSheet
    Foto = Split(CreateObject("wscript.shell").exec("cmd /c dir D:\""test fotos veiling""\*.jpg /b/o-d").stdout.readall, vbCrLf)(0)
    [COLOR="#008000"]' Insert the image.[/COLOR]
    Set s = ws.Shapes.AddPicture(Foto, False, True, 100, 100, 1, 1)
    [COLOR="#008000"]' Use picture's height and width.[/COLOR]
    s.ScaleHeight 1, msoCTrue
    s.ScaleWidth 1, msoCTrue
    ActiveSheet.Pictures.Select
    
    Call Uitsnijden
End Sub

 

[Leondemooij]

Nu loopt hij vast op ..

Set s = ws.Shapes.AddPicture(Foto, False, True, 100, 100, 1, 1)

 

[Leondemooij]

Zo ziet het er trouwens nu uit.

Sub DrawPicture()
    Dim ws As Worksheet, s As Shape, Foto As String
    Set ws = ActiveSheet
    Foto = Split(CreateObject("wscript.shell").exec("cmd /c dir D:\""fotomapexcel""\*.jpg /b/o-d").stdout.readall, vbCrLf)(0)
    ' Insert the image.
    Set s = ws.Shapes.AddPicture(Foto, False, True, 100, 100, 1, 1)
    ' Use picture's height and width.
    s.ScaleHeight 1, msoCTrue
    s.ScaleWidth 1, msoCTrue
    ActiveSheet.Pictures.Select
    
    Call Uitsnijden
End Sub

 

[edmoor]

Die code is goed en gaat dus na het ophalen van dat bestand fout. Maar "loopt vast" zegt helemaal niets natuurlijk.
Vertel wat er gebeurt en welke meldingen je eventueel krijgt. Is de variabele Foto wel gevuld?

Die extra dubbele quotes zijn trouwens overbodig zo.
Dat moet alleen als je er een mapnaam met spaties in hebt staan, maar ze zitten ook niks in de weg zo.

 

[Leondemooij]

Het opgegeven bestand is niet gevonden is de melding.
En in VBA is de code

Set s = ws.Shapes.AddPicture(Foto, False, True, 100, 100, 1, 1)

geel bij foutopsporing.

Hoe bedoeld u is de variabele Foto ingevuld ?

Daar zal het dan wel fout gaan ...

 

[edmoor]

De in jouw code verwerkte code van snb vult de variabele Foto met de naam van het nieuwste bestand in D:\fotomapexcel
Zonder je document kan ik het niet testen, maar wellicht dat het iets anders moet:

Sub DrawPicture()
    Dim ws As Worksheet, s As Shape, Foto As String, Pad As String
    Set ws = ActiveSheet
    Pad = "D:\fotomapexcel\"
    Foto = Pad & Split(CreateObject("wscript.shell").exec("cmd /c dir Pad & "*.jpg" /b/o-d").stdout.readall, vbCrLf)(0)
    
    [COLOR="#008000"]' Insert the image.[/COLOR]
    Set s = ws.Shapes.AddPicture(Foto, False, True, 100, 100, 1, 1)
    [COLOR="#008000"]' Use picture's height and width.[/COLOR]
    s.ScaleHeight 1, msoCTrue
    s.ScaleWidth 1, msoCTrue
    ActiveSheet.Pictures.Select
    
    Call Uitsnijden
End Sub

En zeg maar jij hoor

 

[Leondemooij]

Ik krijg een compileerfout op deze regel.

Foto = Pad & Split(CreateObject("wscript.shell").exec("cmd /c dir Pad & "*.jpg" /b/o-d").stdout.readall, vbCrLf)(0)

 

[edmoor]

Plaats dan je document of een relevant voorbeeld er van.

 

[Leondemooij]

De hele excel + code staat er nu als het goed is bij.

Misschien zien jullie meer fouten , ik ben hier al heel erg lang mee bezig maar ik ben geen expert.

 

[edmoor]

Doe het dan minder mooi eens zo:

Sub DrawPicture()
    Dim ws As Worksheet, s As Shape, Foto As String
    Set ws = ActiveSheet
    Foto = "D:\fotomapexcel\" & Split(CreateObject("wscript.shell").exec("cmd /c dir D:\fotomapexcel\*.jpg /b/o-d").stdout.readall, vbCrLf)(0)
    [COLOR="#008000"]' Insert the image.[/COLOR]
    Set s = ws.Shapes.AddPicture(Foto, False, True, 100, 100, 1, 1)
    [COLOR="#008000"]' Use picture's height and width.[/COLOR]
    s.ScaleHeight 1, msoCTrue
    s.ScaleWidth 1, msoCTrue
    ActiveSheet.Pictures.Select
    
    Call Uitsnijden
End Sub

 

[Leondemooij]

Werkt helemaal top.
Er zit alleen nog 1 bug in die ik niet begrijp.

Als je bij laatste scan een getal invult ( normaal gaat die met een barcode reader )

En bij kopieer scan vul je 1 in gevolgd door tab.

Bij de eerste keer krijg een foutmelding daarna niet meer, wat kan dit zijn ?

 

[Leondemooij]

methode range van object_worksheet is mislukt krijg ik dan

 

[edmoor]

Wijzig daarvoor je Worksheet_Change routine in dit:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Range("B8") > 0 Then
        Call DrawPicture
    End If
    
    If Range("B7") > 0 Then
        Call kopieerscan
    End If
    Application.EnableEvents = True
End Sub

 

[Leondemooij]

Nu werkt het.
Misschien een kleine uitleg ?

 

[edmoor]

Worksheet_Change treedt op als er een wijziging in het werkblad wordt gedaan.
Als dat vanuit datzelfde event gebeurt roept deze zichzelf aan en daar gaat het mis.
Met Application.EnableEvents = False schakel je de Worksheet_Change uit.
Aan het einde zet je die dan weer op True om Worksheet_Change zijn werk weer te kunnen laten doen.