Anzeige
Archiv - Navigation
732to736
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
732to736
732to736
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Fehler im Code

Fehler im Code
Josef
Hallo!
Ich habe in der Recherche folgenden Code gefunden.
Ich habe im Netzlaufwerk H: einen Ordner mit Namen Muster angelegt.
Dann änderte ich im Code KW auf Muster.
Beim Starten des Makros "speichern" und dem Versuch der Ordnerauswahl erhalte ich trotzdem den Fehler "Sie haben nicht den Ordner Muster ausgewählt."
Wo habe ich mich bitte hier geirrt?
Danke
Josef
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) 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 InfoT
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

Private Function GetAOrdner() As String
Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
With xl
.hwnd = FindWindow("xlmain", vbNullString)
.Title = lstrcat("Bitte wählen Sie das Verzeichnis Muster", "")
.Flags = &H1
End With
IDList = SHBrowseForFolder(xl)
If IDList <> 0 Then
FolderName = Space(256)
RVal = SHGetPathFromIDList(IDList, FolderName)
CoTaskMemFree (IDList)
FolderName = Trim(FolderName)
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
GetAOrdner = FolderName
End Function

Public Sub speichern()
Dim strPfad As String
strPfad = GetSetting("Ordner Muster", "Muster", "Pfad")
Do
If strPfad "" Then
If Dir(strPfad, vbDirectory) = "" Then strPfad = GetAOrdner
Else
strPfad = GetAOrdner
End If
If strPfad = "" Then Exit Sub
If Right(strPfad, 2) = "Muster" Then Exit Do
If MsgBox("Sie haben nicht den Ordner Muster ausgewählt.", 37, "Hinweis") = 2 Then Exit Sub
strPfad = ""
Loop
SaveSetting "Ordner Muster", "Muster", "Pfad", strPfad
Application.ScreenUpdating = False
'ActiveSheet.Copy
'ActiveSheet.Name = sWch
ActiveWorkbook.SaveAs (strPfad & "\" & "Muster" & "_" & Format(Date, "YY") & ".xls") '= KW09_04.xls
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Fehler im Code
15.02.2006 07:22:52
ede
guten morgen josef,
wie sah den der code vorher aus und wo ist das laufwerk hinterlegt?
rückmeldung wäre super.
AW: Fehler im Code
15.02.2006 07:33:59
Josef
Hallo Ede!
Danke für Deine Antwort.
Die einzige Änderung die bis jetzt vornahm war die Änderung von "KW" auf "Muster".
Sonst änderte ich nichts am Code.
Josef
AW: Fehler im Code
15.02.2006 07:39:16
ede
hallo nochmal,
mit
strPfad = GetSetting("Ordner Muster", "Muster", "Pfad")
wird ja die variable strPfad aus der registrierung ausgelesen. was steht in in der Variablen strPfad drin?. Vieleicht solltest du vorher einmal diese neu setzen mit savesetting!!!
rückantwort wäre super!
Anzeige
AW: Fehler im Code
15.02.2006 08:41:29
Josef
Hallo Ede
so gehts auch leider nicht:
Public

Sub speichern()
Dim strPfad As String
'strPfad = GetSetting("Ordner Muster", "Muster", "Pfad")
strPfad = "H:\Dok\SVAdgW\Verrechnung SU"
Do
If strPfad <> "" Then
If Dir(strPfad, vbDirectory) = "" Then strPfad = GetAOrdner
Else
strPfad = GetAOrdner
End If
If strPfad = "" Then Exit Sub
If Right(strPfad, 2) = "Muster" Then Exit Do
If MsgBox("Sie haben nicht den Ordner Muster ausgewählt.", 37, "Hinweis") = 2 Then Exit Sub
strPfad = ""
Loop
SaveSetting = "H:\Dok\SVAdgW\Verrechnung SU"
Application.ScreenUpdating = False
'ActiveSheet.Copy
'ActiveSheet.Name = sWch
ActiveWorkbook.SaveAs (strPfad & "\" & "Muster" & "_" & Format(Date, "YY") & ".xls") '= KW09_04.xls
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Fehler im Code
15.02.2006 10:02:51
ede
hallo josef,
schau dir mal in der hilfe die funktionen SaveSetting() und GetSetting() an,
dann verstehst du, was diese funktionen machen!
Du solltest dann dies für deine zwecke anpassen!
gruss
AW: Fehler im Code
15.02.2006 10:09:59
Josef
Danke für Deine Hilfe
josef

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige