[kozaki]

Помогите, пожалуйста.
Нужно на форму вставить кнопку для выбора пути к папке на диске, при отсутствии папки, нужно ее создать.
Это все нужно, для определения пути для сохранения моделей из макроса SolidWorks.
Используется VBA.

Может есть специальный, контрол, только я не знаю какой

[Кулик Алексей aka kpblc]

Я бы искал информацию по WScript.

[Олег (jr.)]

На Win7 или WindowsXP можно вызвать окно диалога так:

Код:

[Выделить все]

Option Explicit
'Добавить ссылки на:
' -->  Tools  -->  Refereces  -->  Microsft Shell Controls And Automation
' -->  Tools  -->  Refereces  -->  Windows Script Host Object Model

Private Function browseForFolderF(sMsg As String, fPath As String) As String
' based on idea by Joe Earnest
Dim oShell As Shell
Dim wscript As WshShell

Set oShell = New Shell

Dim sfolder As String
Dim iColon As String
Dim fErr As Boolean
On Error Resume Next
    Dim oBFF

    Set oBFF = oShell.BrowseForFolder(0, sMsg, 17, fPath)
    If Err Then Err.Clear: wscript.Quit
On Error GoTo 0

If Not IsObject(oBFF) Then wscript.Quit
If Not (LCase(Left(Trim(TypeName(oBFF)), 6)) = "folder") Then wscript.Quit

'WinXP+ only   (Win2k ?)
'MsgBox oBFF.self.Path
'for any version of Windows in place of the above line
On Error Resume Next
    sfolder = oBFF.parentFolder.ParseName(oBFF.Title).Path
    fErr = CBool(Err)
On Error GoTo 0
If fErr Then
    sfolder = oBFF.Title
    iColon = InStr(sfolder, ":")
    If (iColon < 2) Then wscript.Quit
    sfolder = UCase(Mid(sfolder, iColon - 1, 2)) & "\"
End If
If StrComp(Right(sfolder, 1), "\", vbTextCompare) <> 0 Then
sfolder = sfolder & "\"
End If
browseForFolderF = sfolder
End Function


Sub test()
Dim fd As String
fd = browseForFolderF("Select a Folder", "C:\Test")
MsgBox fd
End Sub

Если без окна диалога можно по-другому:

Код:

[Выделить все]

Option Explicit
'Добавить ссылку на:
''-->  Tools  -->  Refereces  -->  Microsoft Scripting Runtime
Sub MkFolder()
Dim strFolder As String

Dim objFSO, objFolder

strFolder = InputBox("Enter folder name to create: ", "Create Folder", "c:\TestFolder")

On Error GoTo Err_Control

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not objFSO.FolderExists(strFolder) Then
 Set objFolder = objFSO.CreateFolder(strFolder)
Else
MsgBox "Folder already exists"
GoTo exit_Here
End If

If Not objFSO.FolderExists(strFolder) Then

MsgBox "Problem creating a folder..."

End If

exit_Here:
Set objFSO = Nothing
Exit Sub

Err_Control:
If Err.Number <> 0 Then
MsgBox "Error occurs: " & Err.Description
Err.Clear
Resume exit_Here
End If

End Sub

[gomer]

в функции BrowseForFolder по идее должна быть опция, показывающая в диалоге кнопку Создать папку, по крайней мере эта опция есть во всех архиваторах и инсталяторах

[Кулик Алексей aka kpblc]

Милости просим в MSDN

[Олег (jr.)]

запусти первый макрос и посмотри есть там кнопка "Создать папку" или нет

[kozaki]

Сообщение от Олег (jr.) запусти первый макрос и посмотри есть там кнопка "Создать папку" или нет

запускал первый, кнопка есть. но макрос не отработал до конца. может я что-то не так делал. Еще завтра на свежую голову посмотрю