Hallo Freunde,
ich habe das Problem zwar schon einmal woanders (ja schande über mich
) gepostet, dort aber keine wirkliche Hilfe bekommen. Aber bisher wurde ich hier noch nie enttäuscht, von daher probiere ich es mal...
Zu meinem "Problem":
Ich suche nach einer Möglichkeit in eine Zelle in Excel durch Auswahl von Dateien mittels z.B. eines Durchsuchen Feldes die Dateititel automatisch in diese Zelle mit einem definierten Trenner <> eintragen zu lassen.
Also z.b. datei1.jpg<>datei2.jpg
Kurz zum Hintergrund. Ich suche diese Lösung für einen csv Importer, den ich dann per PHp auslese und die Spaten dann verarbeite.
Zur Veranschaulichung sieht das dann vereinfacht so aus:
Spaltenbezeichnungen:
id;titel;genre;Medium;Cover; usw.
Beispiel Datensatz
1;Terminator;Action;DVD;Terminator-cv.jpg<>Terminator-ch.jpg; usw.
Das ganze sollte mit VBA als Makro gehen, aber ich habe NULL Ahnung davon. Ich habe ein Script gefunden, welches Dateinamen untereinander packt, aber ich weiß leider nicht, wie ich die Datei richtig abändere um obiges Ergebnis zu erhalten
Über jede Hilfe würde ich mich sehr freuen.
Tribbi
ich habe das Problem zwar schon einmal woanders (ja schande über mich
) gepostet, dort aber keine wirkliche Hilfe bekommen. Aber bisher wurde ich hier noch nie enttäuscht, von daher probiere ich es mal...Zu meinem "Problem":
Ich suche nach einer Möglichkeit in eine Zelle in Excel durch Auswahl von Dateien mittels z.B. eines Durchsuchen Feldes die Dateititel automatisch in diese Zelle mit einem definierten Trenner <> eintragen zu lassen.
Also z.b. datei1.jpg<>datei2.jpg
Kurz zum Hintergrund. Ich suche diese Lösung für einen csv Importer, den ich dann per PHp auslese und die Spaten dann verarbeite.
Zur Veranschaulichung sieht das dann vereinfacht so aus:
Spaltenbezeichnungen:
id;titel;genre;Medium;Cover; usw.
Beispiel Datensatz
1;Terminator;Action;DVD;Terminator-cv.jpg<>Terminator-ch.jpg; usw.
Das ganze sollte mit VBA als Makro gehen, aber ich habe NULL Ahnung davon. Ich habe ein Script gefunden, welches Dateinamen untereinander packt, aber ich weiß leider nicht, wie ich die Datei richtig abändere um obiges Ergebnis zu erhalten
HTML:
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pList As Long, ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Private Type BrowseInfo
hwnd As Long
Root As Long
DisplayName As Long
Title As Long
Flags As Long
FName As Long
lParam As Long
Image As Long
End Type
Public Sub Sabine()
Dim strFolder As String, strName As String, lngRow As Long
strFolder = GetAOrdner("Bitte wählen sie ein Verzeichnis")
If Trim$(strFolder) <> "" Then
Application.ScreenUpdating = False
Columns(1).ClearContents
strName = Dir(strFolder & "\", 16)
Do
If strName <> "." And strName <> ".." Then
lngRow = lngRow + 1
Cells(lngRow, 1) = strName
End If
strName = Dir
Loop Until strName = ""
Application.ScreenUpdating = True
End If
End Sub
Private Function GetAOrdner(Optional varTitel As Variant) As String
Dim BRI As BrowseInfo, lngIDList As Long, lngReturn As Long, strFolderName As String
With BRI
.hwnd = FindWindow("xlMain", vbNullString)
If Not IsMissing(varTitel) Then
.Title = lstrcat(varTitel, "")
Else
.Title = lstrcat("Please select a directory", "")
End If
.Flags = &H1
End With
lngIDList = SHBrowseForFolder(BRI)
If lngIDList <> 0 Then
strFolderName = Space(256)
lngReturn = SHGetPathFromIDList(lngIDList, strFolderName)
CoTaskMemFree (lngIDList)
strFolderName = Trim$(strFolderName)
strFolderName = Left$(strFolderName, Len(strFolderName) - 1)
End If
GetAOrdner = strFolderName
End FunctionÜber jede Hilfe würde ich mich sehr freuen.
Tribbi
