speichern unter

Sub speichern_unter() ChDir "ABC:\Hallo\Test\" ActiveWorkbook.SaveAs Filename:="ABC:\Hallo\Test\", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Range("T1").Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Peter,
lies mal das:

Geschrieben am: 08.09.2005 10:32:33
Hallo Experten,
ich möchte für den "Speichern unter - Dialog" einen fetsen Pfad vorgeben.

Private Sub Speichern()
Dim fn
fn = Application.GetSaveAsFilename("Testdatei", "Excel-Dateien (*.xls), *.xls")
If fn = False Then
MsgBox "Datei wurde nicht gespeichert!"
End If
End Sub

Nun möchte ich, den Speicherort bereits voreinstellen, da die Voreinstellung nicht passt.
Gruß Lutz
Hallo Lutz,
das funktioniert mit den Exceleigenen Dialogen nicht. Versuch es mal so:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Const gcClassnameMSExcel = "XLMAIN"

Public Sub prcSaveAs()
Const strInitialFilename = "Testdatei"
Dim udtOFN As OPENFILENAME
Dim strFilename As String
With udtOFN
.lStructSize = Len(udtOFN)
.hwndOwner = FindWindow(gcClassnameMSExcel, Application.Caption)
.lpstrFilter = "Excelfiles (*.xls)" + Chr$(0) + "*.xls" + Chr$(0)
.lpstrFile = strInitialFilename & Space$(254 - Len(strInitialFilename))
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = "D:\Eigene Dateien\Eigene Tabellen\"
.lpstrTitle = "Save As"
.flags = 0
End With
If GetSaveFileName(udtOFN) Then
strFilename = Trim$(udtOFN.lpstrFile)
MsgBox strFilename 'nur zum testen
' ThisWorkbook.SaveAs strFilename
Else
MsgBox "Datei wurde nicht gespeichert!", 48, "Hinweis"
End If
End Sub

Gruß
Nepumuk
Excel & VBA Beispiele
VG, Ralf

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread