PDA

Click to See Complete Forum and Search --> : ShowSave shows error


pramod kumar
May 10th, 2001, 07:03 AM
I want to save file and I want to give the default file name for that.
I set filename property, but it show some error
plz, help me
this is my code.

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

Public Function ShowSave(Parenthwnd As Long, Filter As String, strSaveFileName As String, InitialDir As String, Title As String, Optional DifExtension As String) As String

Dim OFName As OPENFILENAME
If IsMissing(DifExtension) = False Then
OFName.nFileExtension = 0
End If
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = Parenthwnd
OFName.hInstance = App.hInstance
OFName.lpstrFilter = Filter
OFName.lpstrFile = strSaveFileName 'Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = InitialDir
OFName.lpstrTitle = Title
OFName.flags = 0

If GetSaveFileName(OFName) Then
ShowSave = TrimNull(Trim$(OFName.lpstrFile))
Else
ShowSave = ""
End If
End Function

Private Sub cmdSave_Click()
Dim fl As Long
Dim MyString As String, MyFile As String
fl = FreeFile
MyFile = ShowSave(Me.hWnd, "All files (*.*)" & Chr(0) & "*.*" & Chr(0) & "Log Files (*.log)" & Chr(0) & "*.log" & Chr(0), "MyTxt.txt", "c:\", "Save")

If MyFile <> "" Then
Open MyFile & MySaveName For Output As #fl
Print #fl, Me.Text1.Text
End If

Close #fl
End Sub

Nucleus
May 10th, 2001, 07:58 PM
Here you go:

Option Explicit
Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetActiveWindow Lib "user32" () 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 OFN_HIDEREADONLY = &H4 'hide Open As read only check box
Private Const OFN_OVERWRITEPROMPT = &H2 'show message before overwriting existing files
Private Const OFN_PATHMUSTEXIST = &H800 'refuse filenames with invalid paths


'Purpose : Shows the save file common dialog
'Inputs : strTitle The title of the dialog, pass "" For default
' strDefaultPath The default path
' Filter The filter, an even number of arguments
' e.g.("text files, *.txt, mdb files, *.mdb")
'Outputs : Returns the specified file name And path Or "" If cancelled
'Author : Nucleus

Function ShowSave(Optional strTitle As String, Optional strDefaultPath As String, _
Optional Filter As String) As String
Const clBufferLen As Long = 255
Dim OFName As OPENFILENAME, sBuffer As String * 255
Dim strFilter As String: strFilter = ""
Dim intcount As Integer

'Set title
OFName.lpstrTitle = strTitle

'Set filter
OFName.lpstrFilter = CreateFilterString(Filter)

'Set the initial directory
If strDefaultPath = "" Or Len(Dir$(strDefaultPath)) Then
OFName.lpstrInitialDir = strDefaultPath
Else
OFName.lpstrInitialDir = CurDir$
End If

OFName.lStructSize = Len(OFName)
OFName.hwndOwner = GetActiveWindow 'or Me.hwnd In VB
OFName.hInstance = 0 'or App.hInstance In VB
OFName.lpstrFile = sBuffer
OFName.nMaxFile = clBufferLen 'Set max number of characters
OFName.lpstrFileTitle = sBuffer
OFName.nMaxFileTitle = clBufferLen 'Set max number of characters
OFName.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST

'Show dialog
If GetSaveFileNameA(OFName) Then _
ShowSave = Trim$(OFName.lpstrFile) Else ShowSave = ""

End Function

Private Function CreateFilterString(Filter As String) As String
' Creates a filter String from the passed In arguments.
' Expects an even number of arguments
Dim sa() As String, i%
sa = Split(Filter, ",")

For i = 0 To UBound(sa)
CreateFilterString = CreateFilterString & sa(i) & vbNullChar
Next i
CreateFilterString = CreateFilterString & "All Files (*.*)" & vbNullChar & "*.*"
End Function

'Usage
Private Sub Command1_Click()
MsgBox ShowSave(, "d:", "Text files , *.txt")
End Sub

pramod kumar
May 11th, 2001, 10:40 AM
my problem is when i set filename for default name for saving file
it get error. but there is no problem when ocx (commondialogue ctrl)
used