Dateiname aus Zwischenablage

[bahasu]

Hi Johannes,

anbei eine Version, die den Dateinamen in einer Tabelle speichert.
Im Beispiel zuvor hatte ich die ermittelten Infos in einem ungebundenen Steuerelement angezeigt. Jetzt wird ein gebundenes verwendet.

Inwieweit der Zielpfad zu ermitteln ist, ist mir unbekannt: siehe auch Bemerkungen von daolix.


Alternativ ist auch ein anderes Vorgehen denkbar:
1. In access den Quell-Ordner und die Datei aussuchen und den Ziel-Ordner festlegen + speichern
2. per Klick oder anderem Kommando die selektierte Datei per "SHFileOperation" kopieren.

Diese Variante hat die Eigenschaft bzw. Vorteil, dass Du alles aus einer Umgebung machen kannst und nicht zwischen Explorer und access wechseln musst.

Harald

[Anhang gelöscht durch Administrator]

[Johannes72]

Hallo und guten Morgen

Ich hab mir nur die beinen letzten Tips kurz angeschaut und glaube jetzt mir eine Lösung pasteln zu können.

Leider habe ich heute keine Zeit sondern werd das in den nächsten Tagen machen. Auf jeden Fall möchte ich mir noch einmal vielmals bei euch für die Hilfe bedanken. Diesen Code hätte ich sonst niemals zustade gebracht.

Vielen vielen Dank an alle.

[Johannes72]

Hallo Leute

Ich möchte mich bei euch für eure Hilfe bedanken. Ich habe nun das ganze in meine Datenbank eingebunden und es funktioniert einfach super. (Ich klicke auf einen Button und die Datei wird in ein Verzeichnis kopiert und der Name samt Pfad in mein Textfeld eingefügt.) alles genauso wie ich es mir vogestellt hatte.

Allerdings hätte ich noch eine Frage: Kann man das auch dahigehend ändern daß auch Mails also msg-Dateien erkannt werden. Wenn ich aus Outlook ein Mail in die Zwischenablage kopiere wird sie icht erkannt.

Kann mir da bitte noch einmal jemand helfen?

Danke

[daolix]

Hallo

bei Outlookmessages (msg) welche per CtrlC/CtrlV kopiert wurden, werden die Dateinamen in den Clipboardformaten  FileGroupDescriptor (49428) / FileGroupDescriptorW (49429) abgelegt. Auch hier gilt aber, der Zielordner ist nicht bekannt. Zudem liegt die Information dazu in einer UDT samt Zähler und Array vor. Du musst jetzt prüfen welche Clipboardformate vorliegen ( FileGroupDescriptor oder CF_HDROP, diese kannst du mit Hilfe der Funktion EnumClipboardFormats ermitteln) und dann die entsprechende Ausleseroutine ausführen.

[Johannes72]

Guten Morgen

Das sind die beiden codes die ausgeführt werde:

Public Function GetClipboardFiles(ByRef Files() As String) As Long
      Dim nHandle As Long
    Dim nCount As Long
    Dim nLen As Long
    Dim sFile As String

    Dim nFormat As Long
    Dim hGlobal   As Long
    Dim i As Long

    ' Prüfen, ob Dateien in der Zwischenablage vorhanden
    If IsClipboardFormatAvailable(CF_HDROP) > 0 Then
        ' Zwischenablage öffnen
        If OpenClipboard(0) <> 0 Then
        ' Handle holen
            nHandle = GetClipboardData(CF_HDROP)
            If nHandle <> 0 Then
                ' jetzt alle Dateinamen ermitteln
                nCount = DragQueryFile(nHandle, -1, vbNullString, 0)
                ReDim Files(nCount - 1)
                For i = 0 To nCount - 1
                    nLen = DragQueryFile(nHandle, i, vbNullString, 0)
                    sFile = String$(nLen + 1, 0)
                    nLen = DragQueryFile(nHandle, i, sFile, Len(sFile))
                    Files(i) = Left$(sFile, nLen)
                Next i
            End If

            ' Zwischenablage schließen
            CloseClipboard
        End If
    End If

    GetClipboardFiles = nCount
End Function




und



Private Sub FileSuchen_Click()
    Dim nCount As Long
    Dim sFiles() As String
    Dim Temp As String
   
    nCount = GetClipboardFiles(sFiles())
   
    If nCount > 0 Then
        Temp = sFiles(0)
        If InStr(Temp, "\") > 0 Then Temp = Mid(Temp, InStrRev(Temp, "\") + 1)
        If InStr(Temp, ":") > 0 Then Temp = Mid(Temp, InStrRev(Temp, ":") + 1)
        Me.DateiName = (Text29) & "\" & Temp
        DoCmd.GoToControl "Webbrowser3"
        SendKeys "^v", True

    Else
        MsgBox "Zwischenablage enthält keine Dateien!", vbInformation
    End If
End Sub

Die sind im Grunde genau die Codes die oben gepostet wurden und sind nur leicht geändert. Was muss ich ändern. GetClipboardData(CF_HDROP) steht ja schon drinnen.

[daolix]

Hier mal ne Funktion, doppelte Deklarationen must du löschen, fehlende hinzufügen.

Code (Wie immer, alles ohne Gewähr) [Auswählen] Erweitern

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Private Type FDShort '// aka FILEDESCRIPTOR
    bIchHabJetztKeineLustdieApiUDTsZuSuchen(71) As Byte
    bFile(259) As Byte
End Type

Private Type FGD
    cItems As Long
    fd(0 To 0) As FDShort
End Type

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Declare Function OpenClipboard Lib "USER32.DLL" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "USER32.DLL" () As Long
Declare Function GetClipboardData Lib "USER32.DLL" (ByVal uFormat As Long) As Long
Declare Function GlobalLock Lib "KERNEL32.DLL" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "KERNEL32.DLL" (ByVal hMem As Long) As Long
Declare Sub CopyMemory Lib "KERNEL32.DLL" Alias "RtlMoveMemory" (ByVal pDestination As Long, ByVal pSource As Long, ByVal cbLength As Long)


Function FileNameFromFileGroupDescriptor(byref sf() as string) As long
    Dim lHndl As Long
    Dim pMem As Long
    Dim lItems As Long
    Dim fd() As FDShort
    Dim i As Long
    If OpenClipboard(0) Then
        lHndl = GetClipboardData(49428)
        If lHndl Then
            pMem = GlobalLock(lHndl)
            If pMem Then
                CopyMemory VarPtr(lItems), ByVal pMem, 4
                If lItems Then
                    ReDim sf(1 To lItems)
                    ReDim fd(1 To lItems)
                    CopyMemory VarPtr(fd(1)), ByVal pMem + 4, lItems * Len(fd(1))
                    For i = 1 To lItems
                        sf(i) = VBA.StrConv(fd(i).bFile, vbUnicode)
                        sf(i) = Left$(sf(i), InStr(sf(i), Chr$(0)) - 1)
                    Next
                    FileNameFromFileGroupDescriptor = lItems
                End If
            End If
        End If
    End If
    If pMem Then GlobalUnlock pMem
    CloseClipboard
End Function

deine Funktion must du entsprechend erweitern:

Code [Auswählen] Erweitern


Public Function GetClipboardFiles(ByRef Files() As String) As Long
    ....
    If IsClipboardFormatAvailable(CF_HDROP) > 0 Then
        ...
    elseif  IsClipboardFormatAvailable(49428) then
        nCount = FileNameFromFileGroupDescriptor(Files())
    end if
    GetClipboardFiles = nCount
end Function


[Johannes72]

Hallo

Der erste Teil ist mir klar, da brauch ich nur meinen Code dadurch ersetzen.... Das schaffe ich.

Für den zweiten Teil bin ich aber zu doof. Ich komm nicht drauf wie ich den dort einsetzten muß.

Bitte bitte, würdest Du mir da noch einmal helfen??

Vielen Dank

[daolix]

Ich weis jetzt nicht was du genau meinst, da von "ersetzen" nie die Rede war, du solltest den Code nur hinzufügen, und deine Funktion GetClipboardFiles entsprechend anpassen.
Hier mal das ganze nochmal komplett.

Code (erhebt keinen Anspruch auf Vollständigkeit) [Auswählen] Erweitern


'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Private Type FDShort '// aka FILEDESCRIPTOR
   bIchHabJetztKeineLustdieApiUDTsZuSuchen(71) As Byte
   bFile(259) As Byte
End Type

Private Type FGD
   cItems As Long
   fd(0 To 0) As FDShort
End Type

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Declare Function OpenClipboard Lib "USER32.DLL" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "USER32.DLL" () As Long
Declare Function GetClipboardData Lib "USER32.DLL" (ByVal uFormat As Long) As Long
Declare Function GlobalLock Lib "KERNEL32.DLL" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "KERNEL32.DLL" (ByVal hMem As Long) As Long
Declare Sub CopyMemory Lib "KERNEL32.DLL" Alias "RtlMoveMemory" (ByVal pDestination As Long, ByVal pSource As Long, ByVal cbLength As Long)
Private Declare Function EnumClipboardFormats Lib "USER32.DLL" (ByVal uFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "USER32.DLL" Alias "GetClipboardFormatNameW" (ByVal uFormat As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long



Function FileNameFromFileGroupDescriptor(ByRef sf() As String) As Long
    Dim lHndl As Long
    Dim pMem As Long
    Dim lItems As Long
    Dim fd() As FDShort
    Dim i As Long
    Dim f As Long
   
    f = GetClipboardFormatAvailableByName("FileGroupDescriptor")
    If f Then
        If OpenClipboard(0) Then
            lHndl = GetClipboardData(f)
            If lHndl Then
                pMem = GlobalLock(lHndl)
                If pMem Then
                    CopyMemory VarPtr(lItems), ByVal pMem, 4
                    If lItems Then
                        ReDim sf(1 To lItems)
                        ReDim fd(1 To lItems)
                        CopyMemory VarPtr(fd(1)), ByVal pMem + 4, lItems * Len(fd(1))
                        For i = 1 To lItems
                            sf(i) = VBA.StrConv(fd(i).bFile, vbUnicode)
                            sf(i) = Left$(sf(i), InStr(sf(i), Chr$(0)) - 1)
                        Next
                        FileNameFromFileGroupDescriptor = lItems
                    End If
                End If
            End If
        End If
        If pMem Then GlobalUnlock pMem
        CloseClipboard
    End If
End Function


'// ----------------------------------------------------------------------------------------------------------------
'//  Deine Funktionen
'// ----------------------------------------------------------------------------------------------------------------
Public Function GetClipboardFiles(ByRef Files() As String) As Long
     Dim nHandle As Long
   Dim nCount As Long
   Dim nLen As Long
   Dim sFile As String

   Dim nFormat As Long
   Dim hGlobal   As Long
   Dim i As Long

   ' Prüfen, ob Dateien in der Zwischenablage vorhanden
   If IsClipboardFormatAvailable(CF_HDROP) > 0 Then
       ' Zwischenablage öffnen
       If OpenClipboard(0) <> 0 Then
       ' Handle holen
           nHandle = GetClipboardData(CF_HDROP)
           If nHandle <> 0 Then
               ' jetzt alle Dateinamen ermitteln
               nCount = DragQueryFile(nHandle, -1, vbNullString, 0)
               ReDim Files(nCount - 1)
               For i = 0 To nCount - 1
                   nLen = DragQueryFile(nHandle, i, vbNullString, 0)
                   sFile = String$(nLen + 1, 0)
                   nLen = DragQueryFile(nHandle, i, sFile, Len(sFile))
                   Files(i) = Left$(sFile, nLen)
               Next i
           End If

           ' Zwischenablage schließen
           CloseClipboard
       End If
   '// ----------------------------------------------------------------------------------------------------------------
   '//  Deinen Code erweitern
   '// ----------------------------------------------------------------------------------------------------------------
   ElseIf IsClipboardFormatAvailableByName("FileGroupDescriptor") Then
       nCount = FileNameFromFileGroupDescriptor(Files())
   '// ----------------------------------------------------------------------------------------------------------------
   End If

   GetClipboardFiles = nCount
End Function



Private Sub FileSuchen_Click()
   Dim nCount As Long
   Dim sFiles() As String
   Dim Temp As String
 
   nCount = GetClipboardFiles(sFiles())
 
   If nCount > 0 Then
       Temp = sFiles(lbound(sFiles))
       If InStr(Temp, "\") > 0 Then Temp = Mid(Temp, InStrRev(Temp, "\") + 1)
       If InStr(Temp, ":") > 0 Then Temp = Mid(Temp, InStrRev(Temp, ":") + 1)
       Me.DateiName = (Text29) & "\" & Temp
       DoCmd.GoToControl "Webbrowser3"
       SendKeys "^v", True

   Else
       MsgBox "Zwischenablage enthält keine Dateien!", vbInformation
   End If
End Sub

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Function GetClipboardFormatAvailableByName(ByVal sFormat As String) As Long
    Dim f As Long
    If OpenClipboard(0) Then
        f = EnumClipboardFormats(0)
        Do While f
            If ClipBoardGetFormatName(f) = sFormat Then
                GetClipboardFormatAvailableByName = f
                Exit Do
            End If
            f = EnumClipboardFormats(f)
        Loop
        CloseClipboard
    End If
End Function


'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Function IsClipboardFormatAvailableByName(ByVal sFormat As String) As Boolean
    Dim f As Long
    If OpenClipboard(0) Then
        f = EnumClipboardFormats(0)
        Do While f
            If ClipBoardGetFormatName(f) = sFormat Then
                IsClipboardFormatAvailableByName = True
                Exit Do
            End If
            f = EnumClipboardFormats(f)
        Loop
        CloseClipboard
    End If
End Function

'// ----------------------------------------------------------------------------------------------------------------
'//
'// ----------------------------------------------------------------------------------------------------------------
Function ClipBoardGetFormatName(f As Long) As String
    Select Case f
        Case 1: ClipBoardGetFormatName = "CF_TEXT"
        Case 2: ClipBoardGetFormatName = "CF_BITMAP"
        Case 3: ClipBoardGetFormatName = "CF_METAFILEPICT"
        Case 4: ClipBoardGetFormatName = "CF_SYLK"
        Case 5: ClipBoardGetFormatName = "CF_DIF"
        Case 6: ClipBoardGetFormatName = "CF_TIFF"
        Case 7: ClipBoardGetFormatName = "CF_OEMTEXT"
        Case 8: ClipBoardGetFormatName = "CF_DIB"
        Case 9: ClipBoardGetFormatName = "CF_PALETTE"
        Case 10: ClipBoardGetFormatName = "CF_PENDATA"
        Case 11: ClipBoardGetFormatName = "CF_RIFF"
        Case 12: ClipBoardGetFormatName = "CF_WAVE"
        Case 13: ClipBoardGetFormatName = "CF_UNICODETEXT"
        Case 14: ClipBoardGetFormatName = "CF_ENHMETAFILE"
        Case 15: ClipBoardGetFormatName = "CF_HDROP"
        Case 16: ClipBoardGetFormatName = "CF_LOCALE"
        Case 17: ClipBoardGetFormatName = "CF_DIBV5"
        Case 18: ClipBoardGetFormatName = "CF_MAX"  ' varies by Windows version
        Case &H80: ClipBoardGetFormatName = "CF_OWNERDISPLAY"
        Case &H81: ClipBoardGetFormatName = "CF_DSPTEXT"
        Case &H82: ClipBoardGetFormatName = "CF_DSPBITMAP"
        Case &H83: ClipBoardGetFormatName = "CF_DSPMETAFILEPICT"
        Case &H8E: ClipBoardGetFormatName = "CF_DSPENHMETAFILE"
        Case Else
            Dim sz As String
            Dim l As Long
            sz = String$(260, 0)
            l = GetClipboardFormatName(f, StrPtr(sz), Len(sz))
            ClipBoardGetFormatName = Left$(sz, l)
    End Select
End Function




[Johannes72]

Hallo

Als erstes möchte ich mich noch einmal für Deine Hilfe bedanken um dann auch gleich wieder ungut zu werden...... Ich schaffe es nicht Deinen Code zum laufen zu bringen..... Im Anhang ist eine Fehlermeldung die ich nicht und nicht weg bringe.

Bitte kannst Du mir wieder helfen?

Vielen Dank

[Anhang gelöscht durch Administrator]

[daolix]

hallo
wird wohl daran liegen das du den code einfach nur kopiert und ausgeführt hast, ohne ihn vorher zu kompilieren, denn dann wäre dort schon eine informativere Fehlermeldung erschienen. Also Code vor ausführung immer kompilieren.

anbei ne kleine DB, ohne Verwendung des WebBrowserDingens, da sich mir die Verwendung dessen nicht erschliesst.

[Johannes72]

Hallo

Erstens möchte ich mich wieder für Deine Bemühungen bedanken. Ich hab Deine Datei noch nicht versucht und werde wohl heute auch nicht dazu kommen.

Zur Erklärung mit dem Webbrowser-Steuerelement. Damit ich die Dateien die ich iin der Zwischenablage habe in ein vorher in der DB definiertes Verzeichnis auf der HD kopieren kann, habe ich mir so ein Steuerelement erstellt das auf eben dieses Verzeichnis verlinkt ist und dort werden die Dateien eingefügt. Ist möglicherweise nicht der optimale Weg für einen Programmierer.... tja, ich bin nun mal keiner und es funktioniert für meine Verwendung.

Danke

[Johannes72]

Hallo

Ich habe heute den halben Vormittag damit verbracht den Code den ich von Deiner DB kopiert habe zum laufen zu bringen. Es ist mir leider nicht gelungen.

Ich hab zuerst Deine DB versucht und es hat auch dort nicht geglappt.

Wenn ich eine Datei einfügen möchte, sagt er immer "Keine Datei in Zwischenschenspeicher". Ich habs dann aber dennoch versucht den Code so hin zu bekommen das es funktioniert, habs aber nicht geschaft.

Funktioniert Dein Beispiel bei Dir?

[daolix]

Ich hab zuerst Deine DB versucht und es hat auch dort nicht geglappt.

Wenn ich eine Datei einfügen möchte, sagt er immer "Keine Datei in Zwischenschenspeicher". Ich habs dann aber dennoch versucht den Code so hin zu bekommen das es funktioniert, habs aber nicht geschaft.

Funktioniert Dein Beispiel bei Dir?

de­fi­ni­tiv ja. Wenn ich eine Outlookmessage oder angehängte Datei via ctrl/C aus Outlook kopiere und in der DB die Zwischenablage per klick auslese, wird der Dateiname (subject.msg oder Anhangs.Datei) angezeigt. Warum es bei dir nicht läuft kann ich nicht sagen.

Alternativ solltest du versuchen, sofern es die Firmenrestriktionen erlauben, Outlook über COM anzusteuern, und den Posteingang via VBA auslesen.

[Johannes72]

Hallo

Leider. ich habs jetzt auch auf einem anderen Rechner versucht, das Beispiel von dir funktioniert nicht bei mir.

Nachdem ich mich nun seit Tagen mit diesem Problem beschäftige und es nicht schaffe es zu lösen, hätte ich noch einen anderen Lösungsansatz. Von dem ich allerdings genau so wenig eine Idee habe wie ich das umsetzten soll.

Die Idee ist folgende:

Wenn ich den Code

            DoCmd.GoToControl "Webbrowser3"
            SendKeys "^v", True

ausführe, wird die Datei in ein Webbrowser-Steuerelement kopiert und ist dort dann auch markiert. Kann mann mit einem VB-Code eine markierte Datei umbenennen???

Hab da jetzt eine ganze Zeit lang danach gesucht aber nur den mir bekannten Befehl "rename" gefunden. Doch hier braucht man nicht nur den neuen Namen sondern eben auch den alten.... Und damit wäre ich wieder bei dem Problem das ich jetzt habe. Würde es dafür eine einfache Lösung geben???

Also nocheinmal in Kurzversion:

Datei einfügen und einen beliebigen Dateinamen den man nicht kennt umbenennen....

Eingetlich ganz einfach, wenn´s funktioniert

[daolix]

okay hab vorhergehendse bsp mal aktualisiert. Aktualisierte Version siehe anhang



[Anhang gelöscht durch Administrator]