[drafter]

Im trying to build some VB code for Autocad that works from excel. Ive been here a couple of times now looking for help and i am slow trudging my way through this. I would like to thank everybody for the help they have gave me. That being said i will get to my next request. Below is a piece of my code.

' Save Drawing
On Error Resume Next
MkDir "C:\Documents and Settings\tertom01\Desktop\AutoDraw\New"
On Error GoTo 0

Doc.SaveAs ("C:\Documents and Settings\tertom01\Desktop\AutoDraw\New\" & CriteriaArray(0, 1) & ".dwg")
Doc.Close True

This is the static form of my code and built strictly for my computer. I would like to improve this so people can pick where the "New" folder is built and make that my save folder as well. Can anyone help.

thanx

[orbiferrorum]

I like using "strYourVariableHere = Application.GetSaveAsFilename(parameter list)" to add the dialog box for a user to select the path they want and assign it into a variable

[Rollin_Again]

Here is another way to do this using API calls that will work in any VBA environment not just Excel. Just copy the code below into a module and then run the macro called GetDirectory to see how it works.

Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'API Declares
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

'API Constants
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_STATUSTEXT = 4

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)

Private Const BFFM_SETSELECTIONA = (WM_USER + 102)

'BrowseInfo Type
Private Type BrowseInfo
    hwndOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

'Private Variables
Private m_sDefaultFolder As String


Sub GetDirectory()

vDirectory = BrowseForFolder("", 0, "& Select a directory:")
MsgBox ("You have selected " & vDirectory)

End Sub

Public Function BrowseForFolder(DefaultFolder As String, Optional Parent As Long = 0, Optional Caption As String = "") As String
    Dim bi As BrowseInfo
    Dim sResult As String, nResult As Long

    bi.hwndOwner = Parent
    bi.pIDLRoot = 0
    bi.pszDisplayName = String$(MAX_PATH, Chr$(0))
    If Len(Caption) > 0 Then
        bi.lpszTitle = Caption
    End If
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    bi.lpfn = GetAddress(AddressOf BrowseCallbackProc)
    bi.lParam = 0
    bi.iImage = 0

    m_sDefaultFolder = DefaultFolder

    nResult = SHBrowseForFolder(bi)

    If nResult <> 0 Then
        sResult = String(MAX_PATH, 0)
        If SHGetPathFromIDList(nResult, sResult) Then
            BrowseForFolder = VBA.Left$(sResult, InStr(sResult, Chr$(0)) - 1)
        End If

        CoTaskMemFree nResult
    End If
End Function

Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    Select Case uMsg
        Case BFFM_INITIALIZED

            If Len(m_sDefaultFolder) > 0 Then

                SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal m_sDefaultFolder
            End If
    End Select
End Function

Private Function GetAddress(nAddress As Long) As Long
    GetAddress = nAddress
End Function

Regards,
Rollin

[drafter]

Hi Rollin_Again your code works great but i was thinking of something a little simpler that i could insert into my. It doesnt have to be used in anything but excel.

Hi orbiferrorum I tried your code but remeber i am a newby. what do i put in the parameter list. could you be more elementary for me.

thanx alot guys/girls

[orbiferrorum]

Here's what I found from the Help File,

GetSaveAsFilename Method

Displays the standard Save As dialog box and gets a file name from the user without actually saving any files.

expression.GetSaveAsFilename(InitialFilename, FileFilter, FilterIndex, Title, ButtonText)
expression Required. An expression that returns an Application object.

InitialFilename Optional Variant. Specifies the suggested file name. If this argument is omitted, Microsoft Excel uses the active workbook's name.

FileFilter Optional Variant. A string specifying file filtering criteria.

This string consists of pairs of file filter strings followed by the MS-DOS wildcard file filter specification, with each part and each pair separated by commas. Each separate pair is listed in the Files of type drop-down list box. For example, the following string specifies two file filters, text and addin: "Text Files (*.txt), *.txt, Add-In Files (*.xla), *.xla".

To use multiple MS-DOS wildcard expressions for a single file filter type, separate the wildcard expressions with semicolons; for example, "Visual Basic Files (*.bas; *.txt),*.bas;*.txt".

If omitted, this argument defaults to "All Files (*.*),*.*".

FilterIndex Optional Variant. Specifies the index number of the default file filtering criteria, from 1 to the number of filters specified in FileFilter. If this argument is omitted or greater than the number of filters present, the first file filter is used.

Title Optional Variant. Specifies the title of the dialog box. If this argument is omitted, the default title is used.

ButtonText Optional Variant. Macintosh only.

Remarks
This method returns the selected file name or the name entered by the user. The returned name may include a path specification. Returns False if the user cancels the dialog box.

This method may change the current drive or folder.

Example
This example displays the Save As dialog box, with the file filter set to text files. If the user chooses a file name, the example displays that file name in a message box.

fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.txt), *.txt")
If fileSaveName <> False Then
MsgBox "Save as " & fileSaveName
End If

hopefully this helps a little,

[Rollin_Again]

Have you tried using Orbi's method??

Doc.SaveAs (Application.GetSaveAsFilename(CriteriaArray(0, 1) & ".dwg"))

Regards,
Rollin

[drafter]

This worked but the way i have my code setup is it saves 20 files getting the next filename from my excel spread sheet. So now it is asking me to confirm the same path each time. I would like it to except the first file path i chose and save the rest there. Can you help.

thanx again

[OBP]

Place the "strYourVariableHere = Application.GetSaveAsFilename(parameter list)" outside and before your Loop that picks up the File names.