Всем добрый вечер!
Прошу помочь мне разобраться с такой проблемкой... Есть макрос, который создает определенную книгу, с определенным названием в определенную папку. Я пыталась прописать условие: если такой книги нет-создавай, если уже есть такая- ее открой.
В коде ниже есть такое условие для папки, которая тоже создается макросом. Только папка не открывается при несоблюдении условия, а просто само задание игнорируется. А вот с книгой пошло все не так...
Код:
Sub Main()
Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
Dim strFolder As String
strFolder = "M:\Production\Мастера\2017\Нормализация\" & Range("имя_папки").Value
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm", 52
If Dir(New_Wb, vbDirectory) = "" Then
MkDir New_Wb
End If
Windows("Расчет.xlsm").Activate
End Sub
Также в приложении сам файл-пример.
Всем спасибо заранее за любую идею и помощь! :)
Здравствуйте.
Может быть, просмотреть все файлы в папке (http://www.excel-vba.ru/chto-umeet-excel/prosmotret-vse-fajly-v-papke/) и сравнить имя каждого с искомым. Если нашли, то открыть, иначе создать
Добрый день!
Спасибо за идею и за ссылку)))
Только я вот не особо разбираюсь в макросах. Пробовала вставить не получилось. В кукую строку конкретно нужно вставить? Вместо If Dir(New_Wb, vbDirectory) = "" Then
MkDir New_Wb
End If
И только часть Dim sFolder As String, sFiles As String
'диалог запроса выбора папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
'отключаем обновление экрана, чтобы наши действия не мелькали
Application.ScreenUpdating = False
sFiles = Dir(sFolder & "*.xls*")
Do While sFiles <> ""
'открываем книгу
Workbooks.Open sFolder & sFiles
А куда далее прописать что если нет такого файла, то создай как описано в моем коде выше?
Спасибо за ответ! :)
Еще нашла другой код и получилось:
Sub Main()
Const strRootFolder As String = "M:\Production\Masters\2017\Normalization
Dim strFolder As String
strFolder = "M:\Production\Masters\2017\Normalization\" & Range("folder_name").Value
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Book") & ".xlsm", 52
Папка = "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\"
Имя = Dir(Папка & "*.xls*")
Do While Имя <> ""
If Имя <> "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Book") & ".xlsm" Then MkDir New_Wb Else Workbooks.Open Filename:="M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Book") & ".xlsm"
Имя = Dir
Loop
Windows("Расчет.xlsm").Activate
End Sub
Но все-равно спрашивает заменить уже существующий файл или нет...(((
Решение:
Sub Main()
Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
Dim strFolder As String
strFolder = "M:\Production\Мастера\2017\Нормализация\" & Range("имя_папки").Value
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
Dim strFileName As String
Dim strFileTitle As String
' Имя и путь искомого файла
strFileTitle = "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет нормализации для Шымкента.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет нормализации для Шымкента.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm"
strFileName = "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет нормализации для Шымкента.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет нормализации для Шымкента.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm"
' Проверка наличия файла (функция Dir возвращает пустую _
строку, если по указанному пути файл обнаружить не удалось)
If Dir(strFileName) <> "" Then
MsgBox "OK"
Else
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет нормализации для Шымкента.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет нормализации для Шымкента.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm", 52
End If
Windows("Расчет нормализации для Шымкента.xlsm").Activate
End Sub
А так?
Sub www()
Dim New_Wb As Workbook, s$
CreateObject("Shell.Application").Namespace("m:\").NewFolder ("Production\Мастера\2017\Нормализация\" & Range("имя_папки").Value)
s = "m:\Production\Мастера\2017\Нормализация\" & Range("имя_папки").Value & "\" & Range("Книга") & ".xlsm"
If Dir(s) <> "" Then Exit Sub
Set New_Wb = Workbooks.Add
New_Wb.SaveAs s, 52
End Sub