Variabler Ordnername Definieren
#1
Guten Morgen alle zusammen,
ich bräuchte mal wieder eure hilfe und zwar habe ich eine Excel-Datei in der Ein Commandbutton dafür sorgt das die Kamera geöffnet wird und danach der Dateiexplorer zum auswählen des Bildes, das Bild wird dann automatisch skaliert und an der dafür vorgesehen Stelle eingefügt.
Mein Problem dabei ist das sich der Dateiordner indem sich die Kameraapp befindet sich bei jedem Update verändert, sprich ich müsste den Dateiordner Variabel definieren. Dazu fehlen mir leider die Kenntnisse....
Desweiteren wäre es sehr schön wenn die Kamera ausgelöst hat, sich diese schließt und automatisch das letzte Bild aus dem Ordner "Eigene Aufnahmen" (C:\Users\Name\Pictures\Camera Roll) herrausholt und einfügt. Also ohne das sich der Dateiexplorer öffnet und man es händisch auswählen muss. Dies wäre allerdings zweitrangig.
Ich bedanke mich im Vorraus für jeden der mir hilft.
Code:
Private Sub CommandButton2_Click()
file = "C:\Programme\WindowsApps\Microsoft.WindowsCamera_2022.2209.13.0_x64__8wekyb3d8bbwe\WindowsCamera.exe" 'definiert den Pfad der Kamera
Shell (file) 'Öffnet die Kamera
Dim lngTMP As Long 'Löst das einfügen eines Bildes aus
    With Me
        lngTMP = .Shapes.Count
        Application.CommandBars.FindControl(ID:=2619).Execute
        If .Shapes.Count > lngTMP Then 'Skaliert das Bild und fügt es an die richtige Position ein
            With .Shapes(.Shapes.Count)
                .LockAspectRatio = msoFalse
        .Width = [C5:E12].Width
        .Height = [C5:E12].Height
        .Left = [C5].Left
        .Top = [C5].Top
    End With
    End If
End With
End Sub
Antworten Top
#2
Hallöchen,

schaue Dir mit Dir den Inhalt von C:\Programme\WindowsApps\ an und wenn der String mit "C:\Programme\WindowsApps\Microsoft.WindowsCamera" beginnt, dann übernimmst Du ihn und setzt die App hintendran.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#3
Hallöchen,
habe nun ein weilchen rumprobiert allerdings krieg ich es nicht zum laufen.
Den Ordner "WindowsApps" kann ich nicht öffnen.
Und über die Dir funktion kommt immer die Fehlermeldung Datei nicht gefunden.
Ist es Möglich das Makro so umzuschreiben das er einfach den Ordner Windowsapps und dessen Unterordner nach der Kamera App durchsucht und diese dann öffnet?

Danke für deine Hilfe!
Antworten Top
#4
Google sagt, dass Du hier mal schauen solltest

Stack Overflow
how to capture picture using webcam in vb6.0 - forum - developer Fusion
excel - How to use webcam capture on a Microsoft Access form? - Stack Overflow
Antworten Top
#5
Hallöchen,

wenn Dir Dir den Fehler bringt, dann geht das so nicht.
Der Ordner an sich benötigt spezielle Admin-Zugriffsrechte.

Eventuell kann das und der darin verlinkte weitere Thread helfen:
stackoverflow.-how-to-list-all-installed-applications-in-to-excel
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#6
So ist eventuell schon Lange her, aber vielleicht hat mal jemand anderes ein ähnliches Problem.
Der Ordner "WindowsApps" ist Lese und Schreibgeschützt. dadurch lässt sich der Ordnername nicht Variabel deklarieren. Immerhin existiert dieser Ordner nicht für Excel.
Das automatisch das letzte Bild aus dem Ordner eingefügt wird, hat mittlerweile funktioniert.
Also für alle die ähnliche Vorhaben umsetzen wollen, hier ist mein Code:
Code:
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect Password:="" 'Blattschutz aufheben
file = ActiveWorkbook.Worksheets("Tabelle1").Range("XFD1").Value 'Der Ordnerpfad für die Kamera befindet sich in der Tabelle
Shell (file) 'Öffnet die Kamera
Dim folderPath As String
Dim userName As String

' Benutzernamen abrufen
userName = Environ("USERNAME")

' Ordnerpfad basierend auf dem Benutzernamen festlegen
folderPath = "C:\Users\" & userName & "\Pictures\Camera Roll\"

' Holen Sie sich den Dateinamen und das Änderungsdatum des neuesten Bildes im Ordner
Dim lastFile As String
Dim fileName As String
Dim fileDate As Date

lastFile = Dir(folderPath & "*.jpg", vbNormal)
Do While Len(lastFile) > 0
    If FileDateTime(folderPath & lastFile) > fileDate Then
        fileName = lastFile
        fileDate = FileDateTime(folderPath & lastFile)
    End If
    lastFile = Dir
Loop
       
    'Fügen Sie das neueste Bild in die Excel-Datei ein
    If Len(fileName) > 0 Then
        filePath = folderPath & fileName
        With ActiveSheet.Pictures.Insert(filePath)
            'Passen Sie die Größe und Position des Bildes an
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = Range("F5:H12").Width
            .Height = Range("F5:H12").Height
            .Left = Range("F5").Left
            .Top = Range("F5").Top
        End With
    Else
        MsgBox "Kein Bild gefunden"
    End If
   
End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an K.M.Kay für diesen Beitrag:
  • derHoepp
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste