ShowSave shows error

[pramod kumar]

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]

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]

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