HOMEPATH im Pfad und Inhalt aus BOX übertragen

Hallo,
ich habe folgendes Makro geschrieben (gestartet durch Button) um eine vorgegebene Anzahl von Fragebögen zu erstellen.
Die Fragebögen sollen in einem Ordner auf dem Desktop gespiechert werden welcher aber evtl. erst noch angelegt werden soll.
Ich bekomme das nicht hin, dass er den Ordner erstellt.
Außerdem hängt das Makro an der Stelle, wo es die Inhalte der Boxen auf einem anderen Arbeitsblatt (mit dem Namen "Deckblatt") einfügen soll, es fügt die Inhalte immer auf dem Arbeitsblatt ein, auf dem auch die Buttons sind (Name "Steuerung").
So sieht mein Makro bis jetzt aus...


Private Sub erstellen_Click()
Dim F As String
Dim n As String
Dim a As Integer
Dim i As Integer
Dim Ordner As String
F = FirmaBox()
n = NiederlassungBox()
a = AnzahlBox()
'Ordner auf desktop erstellen'
If Not Dir("%HOMEPATH%\Desktop\Befragung" & F & Format(Date, "dd.mm.yyyy"), vbDirectory) = "%HOMEPATH%\Desktop" Then _
MkDir "%HOMEPATH%\Befragung " & F & " " & Format(Date, "dd.mm.yyyy")
'Fragebogen erstellen'
'Wechsel auf Deckblatt'
Sheets("Deckblatt").Select
'einfügen aus FirmaBox'
Range("D4").Value = F
'einfügen aus NiederlassungBox'
Range("D6").Value = n
'Datum einfügen'
Range("D8").Select
Selection.InsertDateTime DateTimeFormat:="d. MMMM yyyy", InsertAsField:= _
False, DateLanguage:=wdGerman, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False
'Gemäß Anzahl in AnzahlBox abspeichern'
'For-Schleife beginnen'
For i = 1 To a
ActiveWorkbook.SaveAs Filename:=Pfad & "Fragebogen Firma Datum i%.xls", FileFormat _
:=xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Next i
'For-Schleife beenden wenn i="AnzahlBox"'
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
Ordner auf dem Desktop erstellen geht so:
Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" ( _
    ByVal pidl As Long, _
    ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" ( _
    ByVal hwndOwner As Long, _
    ByVal nFolder As Long, _
    ByRef pidl As ITEMIDLIST) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long

Private Type ITEMID
    cb As Long
    abID As Byte
End Type

Private Type ITEMIDLIST
    mkid As ITEMID
End Type

Private Const R_DESKTOP = &H10
Private Const NOERROR = 0

Private Function GetPath(Num&) As String
    Dim lResult As Long, sBuffer As String, idl As ITEMIDLIST
    lResult = SHGetSpecialFolderLocation(FindWindow("XLMAIN", vbNullString), Num, idl)
    If lResult = NOERROR Then
        sBuffer = Space$(512)
        lResult = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal sBuffer)
        If lResult Then GetPath = Trim$(sBuffer)
    End If
End Function

Public Sub Ordner_erstellen()
    Dim F As String: F = "TEST" 'nur zum testen !!!
    Dim strPath As String
    strPath = GetPath(R_DESKTOP)
    strPath = Left$(strPath, Len(strPath) - 1)
    MakeSureDirectoryPathExists strPath & "\Befragung " & F & " " & Format(Date, "dd.mm.yyyy") & "\"
End Sub

Das andere Problem solltest du genauer beschreiben. Wird denn die Tabelle "Deckblatt" nicht aktiviert? Ich kann das nämlich nicht nachvollziehen.
Gruß
Nepumuk
Excel & VBA Beispiele

Beliebteste Forumthreads (12 Monate)

HOMEPATH im Pfad und Inhalt aus BOX übertragen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread