Anzeige
Archiv - Navigation
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
936to940
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

aus Directory in Zelle speichern

aus Directory in Zelle speichern
24.12.2007 09:30:55
Wolfgang
Hallo,
unter Recherche entdeckte ich folgenden Code, der mir über Directory den Pfad eines jeweiligen Ordners in einer MsgBox anzeigt. Wie müßte der Code verändert werden, damit nach Anzeige der MsgBox der jeweilige Pfad in einem ausgeblendeten Tabellenblatt "Basis", Zelle "A3" gespeichert wird und ggfs., sofern sich bereits darin Inhalt befindet, ohne Rückfrage überschrieben wird. Danke schon jetzt für die Rückmeldung und schon jetzt auch allen frohe und erholsame Feiertage.
Herzliche Grüße
Wolfgang
'zeigt den jeweiligen Pfad eines Ordners an
Option Private Module
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare

Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare 

Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Sub DirAuswahl()
Dim sMsg As String, sPath As String
sMsg = "Wählen Sie bitte einen Ordner aus:"
sPath = getdirectory(sMsg)
If sPath  "" Then MsgBox sPath
End Sub



Function getdirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
getdirectory = Left(Path, pos - 1)
Else
getdirectory = ""
End If
End Function


5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: aus Directory in Zelle speichern
24.12.2007 10:09:00
Holger
Hallo Wolfgang,
ersetze in Sub DirAuswahl()
If sPath "" Then MsgBox sPath
durch
If sPath "" Then Worksheets("Basis").Cells(3, 1).Value = sPath
Frohes fest
Holger

Danke Holger - läuft wunderbar !
24.12.2007 10:22:51
Wolfgang
Hallo Holger,
Der Code bzw. die Ergänzung funktioniert wunderbar ! - Herzlichen Dank dafür und weiterhin schöne Weihnachtsfeiertage.
Gruß - Wolfgang

AW: aus Directory in Zelle speichern
24.12.2007 10:14:20
ransi
Hallo Wolfgang
versuche es mal so:
Option Explicit

Public Sub Aufruf()
Dim str
str = get_Folder("Was soll ich machen?")
MsgBox str
Sheets("basis").Range("a3") = str
End Sub

Public Function get_Folder(Optional capt, Optional StartVerzeichniss)
Dim objShell As Object
Set objShell = CreateObject("Shell.Application").BrowseForFolder(0&, capt, &H200, StartVerzeichniss)
If Not objShell Is Nothing Then get_Folder = objShell.Self.Path
End Function

ransi

Anzeige
Danke ransi - läuft auch super !
24.12.2007 10:30:40
Wolfgang
Hallo ransi,
habe auch soeben Deinen Code, der ja viel kürzer ist, getestet. Er läuft wunderbar und auch die MsgBox ist da wieder vorhanden. Herzlichen Dank auch Dir für die Rückmeldung und Überlassung des Codes. Weiterhin frohe Feiertage.
Gruß - Wolfgang

AW: aus Directory in Zelle speichern
24.12.2007 10:23:32
Gerd
Hallo Wolfgang!
If sPath "" Then
MsgBox sPath
If Not IsEmpty(Worksheets("Basis").Range("A3") then
Worksheets("Basis").Range("A3").Value= sPath
end if
End if
Je nach deinen Erfordernissen noch
ThisWorkbook. oder Workbooks("xyz.xls"). vor Worksheets
Schöne Feiertage
Gerd

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige