Getting a file path using the Browse button and Save As window

[RalphBrown99]

Hi:

I have a VBA macro that is using at some point a full path in order to get data from an Excel file. I am changing the data from the original file to the file that is localized in the full address. Now I want to use a Browse button and generate the Save As Window to capture the data directly from source file.

Is there a piece of code that open the Save As window that I need and return the full path so I can use it in my original code?

I am sending a word document with a picture that shows the window that I want to call

Thanks in advance

Rafael

[Hallex]

Hi Rafael, found the code on this forum,

see if this working for you

Option Explicit


            Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
            "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) 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
            Public Function ShowOpen(Filter As String, _
            InitialDir As String, _
            DialogTitle As String) As String
            Dim OFName As OPENFILENAME
            'Set the structure size
            OFName.lStructSize = Len(OFName)
            'Set the owner window
            OFName.hwndOwner = 0
            'Set the filter
            OFName.lpstrFilter = Filter
            'Set the maximum number of chars
            OFName.nMaxFile = 255
            'Create a buffer
            OFName.lpstrFile = Space(254)

            'Create a buffer
            OFName.lpstrFileTitle = Space$(254)
            'Set the maximum number of chars
            OFName.nMaxFileTitle = 255
            'Set the initial directory
            OFName.lpstrInitialDir = InitialDir
            'Set the dialog title
            OFName.lpstrTitle = DialogTitle
            'no extra flags
            OFName.flags = 0
            'Show the 'Open File' dialog
            If GetOpenFileName(OFName) Then
            ShowOpen = Trim(OFName.lpstrFile)
            Else
            ShowOpen = ""
            End If
            End Function

            ''Make a form and place the following code listed below on a button to
            ''call the showopen routine.

            Private Sub CommandButton1_Click()
            Dim Filter As String
            Dim InitialDir As String
            Dim DialogTitle As String
            Dim OutputStr As String

            Filter = "Drawing Files (*.dwg)" + Chr$(0) + "*.dwg" + Chr$(0) + _
            "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
            InitialDir = "C:\Program Files\AutoCAD 2006\Sample"
            DialogTitle = "Open a DWG file"
            OutputStr = ShowOpen(Filter, InitialDir, DialogTitle)
            MsgBox OutputStr
            End Sub

Private Sub CommandButton2_Click()
            Dim Filter As String
            Dim InitialDir As String
            Dim DialogTitle As String
            Dim OutputStr As String

            Filter = "Drawing Files (*.dwg)" + Chr$(0) + "*.dwg" + Chr$(0) + _
            "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
            InitialDir = "C:\Program Files\AutoCAD 2006\Sample"
            DialogTitle = "Type a DWG file name with extension"
            OutputStr = ShowOpen(Filter, InitialDir, DialogTitle)
            MsgBox OutputStr
End Sub

~'J'~

[RalphBrown99]

Hi Hallez:

Thanks for your cooperation. I will try, the most probable is that I have to debug the code in anyway. I hope to keep communication.

Rafael

[Ed__Jobe]

Mine is very similar to that. I started with something similar, but added other features supported by the win32 api, like multiselect and longer paths. Save the code below to a class module.

Option Explicit

'Notice: Don't forget to set the OwnerHwnd property to the
'handle of the calling window in order to bind the dialog
'to the calling window.

'//The Win32 API Functions///
Private Declare Function GetSaveFileName Lib _
"COMDLG32.DLL" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Private Declare Function GetOpenFileName Lib _
"COMDLG32.DLL" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

'//Available Flags///
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000                         '  new look commdlg
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10


'//The Structure
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 class variables
Private lngHwnd As Long
Private strFilter As String
Private strTitle As String
Private strDir As String
Private strFile As String   'elj
Private lngSelectedFilter As Long
Private blnHideReadOnly As Boolean
Private blnMode As Boolean

Private Sub Class_Initialize()
  'Set default values when
  'class is first created
  strDir = CurDir
  strTitle = "Select File"
  strFile = ""
  strFilter = "All Files" _
  & Chr$(0) & "*.*" & Chr$(0)
  lngSelectedFilter = 0
  lngHwnd = &O0 'Desktop
End Sub

Public Property Let OwnerHwnd(WindowHandle As Long)
  '//FOR YOU TODO//
  'Use the API to validate this handle
  lngHwnd = WindowHandle
  'R14 users who just want to use this code:
  'Simple, don't set this property! the default
  'of &0 will work fine for most of your needs
End Property

Public Property Get OwnerHwnd() As Long
  OwnerHwnd = lngHwnd
End Property

'elj added property
Public Property Let MultiSelect(mode As Boolean)
    blnMode = mode
End Property

'elj added property
Public Property Get MultiSelect() As Boolean
  MultiSelect = blnMode
End Property

Public Property Get SelectedFilter() As Long
  SelectedFilter = lngSelectedFilter
End Property

Public Property Let SelectedFilter(FilterNumber As Long)
  lngSelectedFilter = FilterNumber
End Property

'elj added property
Public Property Let StartFile(FileName As String)
  'don't allow null strings
  If Not FileName = vbNullString Then
    strFile = FileName
  End If
End Property

'elj added property
Public Property Get StartFile() As String
  StartFile = strFile
End Property

Public Property Let StartInDir(StartDir As String)
  'don't allow null strings
  If Not StartDir = vbNullString Then
    strDir = StartDir
  End If
End Property

Public Property Get StartInDir() As String
  StartInDir = strDir
End Property


Public Property Let Title(Caption As String)
  'don't allow null strings
  If Not Caption = vbNullString Then
    strTitle = Caption
  End If
End Property

Public Property Get Title() As String
  Title = strTitle
End Property

Public Property Let Filter(ByVal FilterString As String)
  'Filters change the type of files that are
  'displayed in the dialog. I have designed this
  'validation to use the same filter format the
  'Common dialog OCX uses:
  '"All Files (*.*)|*.*"
  Dim intPos As Integer
  Do While InStr(FilterString, "|") > 0
    intPos = InStr(FilterString, "|")
    If intPos > 0 Then
      FilterString = Left$(FilterString, intPos - 1) _
      & Chr$(0) & Right$(FilterString, _
      Len(FilterString) - intPos)
    End If
  Loop
  If Right$(FilterString, 2) <> Chr$(0) & Chr$(0) Then
    FilterString = FilterString & Chr$(0)
  End If
  strFilter = FilterString
End Property


Public Property Get Filter() As String
  'Here we reverse the process and return
  'the Filter in the same format that it was
  'entered
  Dim intPos As Integer
  Dim strTemp As String
  strTemp = strFilter
  Do While InStr(strTemp, Chr$(0)) > 0
    intPos = InStr(strTemp, Chr$(0))
    If intPos > 0 Then
      strTemp = Left$(strTemp, intPos - 1) _
      & "|" & Right$(strTemp, _
      Len(strTemp) - intPos)
    End If
  Loop
  If Right$(strTemp, 1) = "|" Then
    strTemp = Left$(strTemp, Len(strTemp) - 1)
  End If
  Filter = strTemp
End Property

Public Property Let HideReadOnly(blnVal As Boolean)
  'Simple one
  blnHideReadOnly = blnVal
End Property

Public Property Get HideReadOnly() As Boolean
  HideReadOnly = blnHideReadOnly
End Property

'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File open dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowOpen() As String
  Dim strTemp As String
  Dim udtStruct As OPENFILENAME
  udtStruct.lStructSize = Len(udtStruct)
  'Use our private variable
  udtStruct.hwndOwner = lngHwnd
  'Use our private variable
  udtStruct.lpstrFilter = strFilter
  udtStruct.nFilterIndex = lngSelectedFilter
  'elj start
'  udtStruct.lpstrFile = Space$(254)    elj comment out
  If Not strFile = vbNullString Then
    udtStruct.lpstrFile = strFile & Space(254 - Len(strFile))
  Else
    udtStruct.lpstrFile = Space$(254)
  End If
  'elj end
  udtStruct.nMaxFile = 255
  udtStruct.lpstrFileTitle = Space$(254)
  udtStruct.nMaxFileTitle = 255
  'Use our private variable
  udtStruct.lpstrInitialDir = strDir
  'Use our private variable
  udtStruct.lpstrTitle = strTitle
  'Ok, here we test our boolean to
  'set the flags
  udtStruct.Flags = 0
  If blnHideReadOnly Then udtStruct.Flags = OFN_HIDEREADONLY + udtStruct.Flags
  If blnMode Then udtStruct.Flags = OFN_EXPLORER + OFN_ALLOWMULTISELECT + udtStruct.Flags
  If GetOpenFileName(udtStruct) Then
    strTemp = (Trim(udtStruct.lpstrFile))
    ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
  End If
End Function

'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File Save dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowSave() As String
    Dim strTemp As String
  Dim udtStruct As OPENFILENAME
  udtStruct.lStructSize = Len(udtStruct)
  'Use our private variable
  udtStruct.hwndOwner = lngHwnd
  'Use our private variable
  udtStruct.lpstrFilter = strFilter
'  udtStruct.lpstrFile = Space$(254)    'elj comment out
  'elj start
  If Not strFile = vbNullString Then
    udtStruct.lpstrFile = strFile & Space(254 - Len(strFile))
  Else
    udtStruct.lpstrFile = Space$(254)
  End If
  'elj end
  udtStruct.nMaxFile = 255
  udtStruct.lpstrFileTitle = Space$(254)
  udtStruct.nMaxFileTitle = 255
  'Use our private variable
  udtStruct.lpstrInitialDir = strDir
  'Use our private variable
  udtStruct.lpstrTitle = strTitle
  'Ok, here we test our flag
  If blnHideReadOnly Then
    udtStruct.Flags = OFN_HIDEREADONLY
  Else
    udtStruct.Flags = 0
  End If
  If GetSaveFileName(udtStruct) Then
    strTemp = (Trim(udtStruct.lpstrFile))
    ShowSave = Mid(strTemp, 1, Len(strTemp) - 1)
  End If
End Function
   
 

[RalphBrown99]

Hi guys:

I am closer for sure to get my window that give me access to the file that I will use in my macro. I am debugging right now and I the program always stops in lines that the lines:

Filter = "Drawing Files (*.dwg)" + Chr$(0) + "*.dwg" + Chr$(0) + _
            "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)                                           

OFName.lpstrFile = Space$(254)

The program highlight in yellow the routines and add a mask in the code that I have highlighted in thes message.

Any clue how to solve the problem? I am using Windows 7 x64bit

Thanks in advance

Rafael

[RalphBrown99]

Hi Hallex:

I am wondering of you have an idea how to change the settings for either Dimension Styles and Multileader Styles using VBA.

In my case I have captured a value but I do not know how to change values based in this number. I want to set up

-Base line Spacing

-Exend Beyond Lines

-Offset from origin

etc etc

I want to do the same with a Multi Leader Style

Thanks in advance for your cooperation

Rafael

[Alfred.NESWADBA]

Hi,

....and adding to my answer in the other post: >>>crossposting<<< + mixing different themes in the same thread is definitly not the way how forums work! ;(

- alfred -

[Hallex]

I haven't tried to work with MleaderStyles but

I will try to do it tomorrow, with no garrantee of course

Just found in my library this code to work with dimstyles yet:

Option Explicit
' by Gary McMaster
Sub CopyFromDimStyle()

Dim CurDimStyle As AcadDimStyle
Dim NewDimstyle As AcadDimStyle
Dim iAltUnits As Integer
Dim dDimScale As Double

'Save copy of current dimstyle
Set CurDimStyle = ThisDrawing.ActiveDimStyle

'Create new dimstyle
Set NewDimstyle = ThisDrawing.DimStyles.Add("My_New_Dimstyle")

'Set newly created dimstyle current
ThisDrawing.ActiveDimStyle = NewDimstyle

'Save the target "dimvar" values
dDimScale = ThisDrawing.GetVariable("Dimscale")
iAltUnits = ThisDrawing.GetVariable("Dimalt")

'Alter the target "dimvar" values
ThisDrawing.SetVariable "Dimscale", 2#
ThisDrawing.SetVariable "Dimalt", 1

'Copy new document dimvar settings into new dimstyle
NewDimstyle.CopyFrom ThisDrawing

'Set original dimstyle current
ThisDrawing.ActiveDimStyle = CurDimStyle

'Restore the altered "dimvar" values
ThisDrawing.SetVariable "Dimscale", dDimScale
ThisDrawing.SetVariable "Dimalt", iAltUnits

'Copy restored document dimvar settings into original dimstyle
CurDimStyle.CopyFrom ThisDrawing

Set CurDimStyle = Nothing
Set NewDimstyle = Nothing

End Sub

~'J'~

[RalphBrown99]

Hi sorry for the missunderstanting:

No problem I will re-start a new Thread for diiferent topics. I was just asking different persons the same question, I tried in the forum but nobody answered so I did this way last time -actually you answer me a direct/different question before-. I did not put your answer in anohter Thread, it was the same question for different person

Apologize in advance

Rafael

[Hallex]

No problem, forget about

Here is my attempt for mleader style

Option Explicit

Public Sub MakeMlederStyle()
Dim i
Dim mldStyleDict As AcadDictionary
   Set mldStyleDict = ThisDrawing.Dictionaries.Item("ACAD_MLEADERSTYLE")
   'add mleader style first
   mldStyleDict.AddObject "MyNewStyle", "AcDbMLeaderStyle"

      Dim mldStyle As AcadMLeaderStyle
          
      For i = 0 To mldStyleDict.Count - 1
      Dim acObj As AcadObject
      Set acObj = mldStyleDict.Item(i)
      Set mldStyle = acObj
      If mldStyle.Name = "MyNewStyle" Then
      Exit For
      Else
      MsgBox "Problem creating the style"
      Exit Sub
      End If
      Next
          
    'then change style settings:
    With mldStyle
          .Annotative = False
          .AlignSpace = 0
          ' set arrow block
          ThisDrawing.SetVariable "dimldrblk", "_closed"
          .ArrowSymbol = "_closed"
          .ArrowSize = 0.18
          .BlockConnectionType = 0
          .BreakSize = 0.18
          .ContentType = acMTextContent
          .Description = "Mleader style for annotation"
          .EnableLanding = True
          .LandingGap = 0.24
          .EnableDogleg = True
          .DoglegLength = 0.18
          .DrawLeaderOrderType = acDrawLeaderHeadFirst
          .DrawMLeaderOrderType = acDrawLeaderFirst
          .MaxLeaderSegmentsPoints = 2
          .FirstSegmentAngleConstraint = acDegreesAny
          .SecondSegmentAngleConstraint = acDegreesHorz
          .LeaderLineType = acStraightLeader
          .LeaderLineColor.ColorIndex = acByLayer
          .LeaderLineWeight = acLnWtByLayer
          .TextAlignmentType = acCenterAlignment
          .TextStyle = "ROMANS"         'text style name
          .TextAngleType = acHorizontalAngle
          .TextColor.ColorIndex = acByLayer
          .TextHeight = 0.15
          .TextLeftAttachmentType = acAttachmentMiddleOfBottom
          .TextRightAttachmentType = acAttachmentMiddleOfBottom

  End With
     
End Sub

~'J'~