Vba word создать папку

5.3K

27 ноября 2003 года

Bodgo

7 / / 22.11.2003

Большушее спасибо !!!
Очень рад, что есть люди которые могут помочь…

ps:
МАКРОС РАБОТАЕТ!!!, но.. вот уж это вечное но!!
Прошу прощение, но задача была поставлена не полностью ( а если точно не правильно)
В папке может быть несколько документов Ворд
Их нужно сохранить в подпапке в формате Ворд6.0
Первый сохраняет все ОК!
А потом, и это понятно, не дает выполнить макрос, т.к. нет возможности создать папку котрая уже есть.

И на закуску, а может есть возможность как то
в документе Ворд макросом изменять текст ВордАрт,
в простой текст?
из области фантастики, наверное.

Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.

Создание папки макросом

Страницы 1

Чтобы отправить ответ, вы должны войти или зарегистрироваться

Сообщений [ 10 ]

1 25.09.2015 15:53:47

  • Melkiy
  • рядовой
  • Неактивен
  • Зарегистрирован: 14.09.2015
  • Сообщений: 7

Тема: Создание папки макросом

Искал, НЕ НАШЁЛ smile  Подскажите (научите) как макросом в Word (2010) создать папку?

2 Ответ от Alex_Gur 25.09.2015 16:20:30

  • Создание папки макросом
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Создание папки макросом

Melkiy пишет:

Искал, НЕ НАШЁЛ smile  Подскажите (научите) как макросом в Word (2010) создать папку?

Папку на диске?

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк — 41001162202962; на WebMoney — R581830807057.

3 Ответ от Melkiy 25.09.2015 16:24:02

  • Melkiy
  • рядовой
  • Неактивен
  • Зарегистрирован: 14.09.2015
  • Сообщений: 7

Re: Создание папки макросом

да, не важно на каком. я так понимаю путь потом можно изменить.

4 Ответ от Alex_Gur 25.09.2015 16:44:52

  • Создание папки макросом
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Создание папки макросом

Попробуйте так:

MkDir ActiveDocument.Path & "Новая"

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк — 41001162202962; на WebMoney — R581830807057.

5 Ответ от Melkiy 25.09.2015 16:51:15

  • Melkiy
  • рядовой
  • Неактивен
  • Зарегистрирован: 14.09.2015
  • Сообщений: 7

Re: Создание папки макросом

sad  не получилось

Post’s attachments

Пример.dot 58 Кб, 1 скачиваний с 2015-09-25 

You don’t have the permssions to download the attachments of this post.

6 Ответ от Boris_R 25.09.2015 17:03:22

  • Boris_R
  • полковник
  • Неактивен
  • Зарегистрирован: 07.08.2012
  • Сообщений: 234
  • Поблагодарили: 110
  • За сообщение: 1

Re: Создание папки макросом

Объект FileSystemObject метод CreateFolder
Примеры кода на сайте scriptcoding.ru
внешняя ссылка

7 Ответ от Melkiy 25.09.2015 17:19:10

  • Melkiy
  • рядовой
  • Неактивен
  • Зарегистрирован: 14.09.2015
  • Сообщений: 7

Re: Создание папки макросом

чем дальше в лес, тем …. как эти скрипты подвязать к word? попроще ни как? извините

8 Ответ от Alex_Gur 25.09.2015 17:37:57

  • Создание папки макросом
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492
  • За сообщение: 1

Re: Создание папки макросом

У меня создается (папка создается в той же директории, что и файл (файл должен быть предварительно сохранен в какую-либо директорию)):

Sub MakeDir1()
    MkDir ActiveDocument.Path & "Новая"
End Sub

Но только один раз.
Если такая папка уже существует, то выдается ошибка.
Нужно еще сделать проверку на существование папки. Это я постараюсь сделать позже.

Post’s attachments

Doc3.docm 16.67 Кб, 2 скачиваний с 2015-09-25 

You don’t have the permssions to download the attachments of this post.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк — 41001162202962; на WebMoney — R581830807057.

9 Ответ от Melkiy 25.09.2015 17:46:55

  • Melkiy
  • рядовой
  • Неактивен
  • Зарегистрирован: 14.09.2015
  • Сообщений: 7

Re: Создание папки макросом

Спасибо за старания. Если честно, не думал, что так сложно. Казалось бы, что такого? всего лишь создать папку

10 Ответ от Alex_Gur 25.09.2015 17:53:51

  • Создание папки макросом
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Создание папки макросом

Сейчас производится проверка на наличие папки в директории:

Sub MakeDir1()
    Dim srtFold As String
    srtFold = ActiveDocument.Path & "Новая"
    If Dir(srtFold, vbDirectory) = "" Then
        MkDir srtFold
    End If
End Sub

Если честно, не думал, что так сложно. Казалось бы, что такого? всего лишь создать папку

Вообще-то, это не так просто. Word, все же, текстовый редактор, а не менеджер файлов. smile

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк — 41001162202962; на WebMoney — R581830807057.

Сообщений [ 10 ]

Страницы 1

Чтобы отправить ответ, вы должны войти или зарегистрироваться

Похожие темы

  • Просмотр папки с файлами
  • Составление списка файлов из папки
  • Ошибка при удалении файла или папки
  • Макрос для изменения папки для сохранения файлов по умолчанию
  • Открытие файла из неактивной папки с помощью окна Открытие документа
  • Что не так с макросом
  • Замена макросом
  • Подпись макросом

Создание папки макросом

Microsoft Word – очень мощный текстовый редактор, он предлагает пользователю массу возможностей и позволяет не просто набрать, отредактировать документ, но и сделать это максимально быстро, исключить или ускорить часто повторяющиеся операции. Наш сайт о Microsoft Office Word даст ответ про: сделать заголово в ворде 2013.

Помочь разобраться с настройками и программированием Ворда могут на форуме сайта Ворд Эксперт. Здесь обсуждаются настройки, оформление, форматирование текстов. Наш сайт о Microsoft Office Word даст ответ про: хочу стать комментатором.
Приведены примеры написания разнообразных шаблонов и макросов, имеется список необходимой литературы. Наш сайт о Microsoft Office Word даст ответ про: закрепить рамку в ворде.

Кроме того на форуме можно воспользоваться готовыми наработками или попросить помощи в соответствующем разделе. Наш сайт о Microsoft Office Word даст ответ про: microsoft powerpoint 2007 как восстановить ярлык.

VBA MkDir function in Excel is categorized as File and Directory function. This built-in VBA MkDir function creates a new folder or directory in Excel VBA. If the folder or the directory already exists, returns an error.

This function use in either procedure or function in a VBA editor window in Excel. We can use this VBA MkDir Function in any number of times in any number of procedures or functions. In the following section we learn what is the syntax and parameters of the MkDir function, where we can use this MkDir Function and real-time examples in Excel VBA.

Table of Contents:

  • Overview
  • Syntax of VBA MkDir Function
  • Parameters or Arguments
  • Where we can apply or use VBA MkDir Function?
  • Example 1: Create a New Folder
  • Example 2: Check and Create a New Directory
  • Example 3: Create Directory in the Current Drive
  • Example 4: Create a New Folder(Returns an Error)
  • Instructions to Run VBA Macro Code
  • Other Useful Resources

The syntax of the MkDir Function in VBA is

MkDir(Path)

The MkDir Function doesn’t return any value. It creates a new folder or directory.

Parameters or Arguments:

The MkDir function/statement has one argument in Excel VBA.
where
Path: It is a mandatory string parameter. The path argument represents the folder or directory to create.

Where we can apply or use VBA MkDir Function?

We can use this MkDir Function in VBA MS Office 365, MS Excel 2016, MS Excel 2013, 2011, Excel 2010, Excel 2007, Excel 2003, Excel 2016 for Mac, Excel 2011 for Mac, Excel Online, Excel for iPhone, Excel for iPad, Excel for Android tablets and Excel for Android Mobiles.

Example 1: Create a New Folder

Here is a simple example of the VBA MkDir function. This below example create a new foler and displays message.

'Create a New Folder
Sub VBA_MkDir_Function_Ex1()

    'Variable declaration
    Dim sPath As String
    
    sPath = "C:SomeswariVBAF1VBA FunctionsVBA Text FunctionsTest"
    
    MkDir sPath
        
    MsgBox "Folder has created : " & vbCrLf & sPath, vbInformation, "VBA MkDir Function"
    
End Sub

Output: Here is the screen shot of the first example output.
VBA MkDir Function

Example 2: Check and Create a New Directory

Here is a simple example of the VBA MkDir function. This below example checks for the direcetory exists or not. If it doesn’t exists, creates a new directory.

'Check and Create a New Directory
Sub VBA_MkDir_Function_Ex2()

    'Variable declaration
    Dim sPath As String
        
    sPath = "C:Test"
    
    If Len(Dir(sPath, vbDirectory)) = 0 Then
       MkDir sPath
       MsgBox "Directory Created Successfully : " & vbCrLf & sPath, vbInformation, "VBA MkDir Function"
    End If
        
End Sub

Output: Here is the screen shot of the second example output.
VBA MkDir Function

Example 3: Create Directory in the Current Drive

Here is a simple example of the VBA MkDir function. This below example checks for the drive exists or not. If it doesn’t exists, creates a folder in the current drive.

'Create Directory in the Current Drive
Sub VBA_MkDir_Function_Ex3()

    'Variable declaration
    Dim sPath As String
        
    sPath = "Test_Drive"
    
    If Len(Dir(sPath, vbDirectory)) = 0 Then
       MkDir sPath
       MsgBox "Created Directory in the current drive : " & vbCrLf & sPath, vbInformation, "VBA MkDir Function"
    End If
        
End Sub

Output: Here is the screen shot of the third example output.
VBA MkDir Function

Example 4: Create a New Folder(Returns an Error)

Here is a simple example of the VBA MkDir function. This below example returns an error. Because the folder is already exists.

'Create a New Folder
Sub VBA_MkDir_Function_Ex4()

    'Variable declaration
    Dim sPath As String
    
    sPath = "C:SomeswariVBAF1VBA FunctionsVBA Text FunctionsTest"
    
    'Note: Folder is already available.
    MkDir sPath
        
    MsgBox "Folder doesn't create : " & vbCrLf & sPath, vbInformation, "VBA MkDir Function"
    
End Sub

Output: Here is the screen shot of the fourth example output.
VBA MkDir Function

Instructions to Run VBA Macro Code or Procedure:

You can refer the following link for the step by step instructions.

Instructions to run VBA Macro Code

Other Useful Resources:

Click on the following links of the useful resources. These helps to learn and gain more knowledge.

VBA Tutorial VBA Functions List VBA Arrays in Excel Blog

VBA Editor Keyboard Shortcut Keys List VBA Interview Questions & Answers

 

Kentavrik7

Пользователь

Сообщений: 433
Регистрация: 13.04.2016

#1

10.07.2018 12:06:45

Здравствуйте. Код должен по идее создать папку по нажатию кнопки, под именем вписанным в поле (Textbox). А также сохранить туда текущий документ с таким же именем. но он просто создает папку при чем необходимо чтобы папка создавалась на уровень выше но такого не происходит помогите разобраться почему (Word)

Код
  Private Sub CommandButton1_Click()
Dim s1
s1 = ActiveDocument.Path & ""
  On Error Resume Next
    MkDir s1 & TextBox1.Value
    ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & ActiveDocument.Name, FileFormat:=wdFormatFlatXMLTemplateMacroEnabled
End Sub
 

Nordheim

Пользователь

Сообщений: 3154
Регистрация: 18.04.2017

#2

10.07.2018 12:09:17

Цитата
Kentavrik7 написал:
(Word)

А причем ту форум по Excel, если вопрос по Word?

«Все гениальное просто, а все простое гениально!!!»

 

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#3

10.07.2018 12:12:23

Цитата
Kentavrik7 написал:
папка создавалась на уровень выше но такого не происходит

потому что такого просто нет в коде. Там берется путь к папке с активным документом. Чтобы определить папку выше можно просто использовать InStrRev для поиска последнего слеша:

Код
s1 = Mid(ActiveDocument.Path,1,instrrev(ActiveDocument.Path,""))

Цитата
Kentavrik7 написал:
но он просто создает папку

уберите On Error Resume Next и увидите почему. Что-то явно не дает его сохранить. Разбирайтесь с самой ошибкой.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Дмитрий(The_Prist) Щербаков, Спасибо. Создает верно папку. А вот с сохранением ошибка Run-time Error ‘4198’ ошибка команды

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#5

10.07.2018 12:32:56

Как вариант

Код
s1=CreateObject("Scripting.FileSystemObject").GetParentFolderName(ActiveDocument.Path)

разделитель добавить по вкусу.

У меня код работает. для проверки так написал

Код
Sub CommandButton1_Click()
Dim s1
s1 = CreateObject("Scripting.FileSystemObject").GetParentFolderName(ActiveDocument.Path) & ""
  On Error Resume Next
    MkDir s1 & "111"
    ActiveDocument.SaveAs FileName:=s1 & "111" & "" & ActiveDocument.Name, FileFormat:=wdFormatFlatXMLTemplateMacroEnabled
End Sub

По вопросам из тем форума, личку не читаю.

 

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#6

10.07.2018 12:34:10

Цитата
Kentavrik7 написал:
А вот с сохранением ошибка

А Гугл что по этому поводу говорит? Такие ошибки возникают если есть некие повреждения структуры документа. Наблюдалось такое, если в Word есть гиперссылки. Попробуйте удалить гиперссылки(если они есть) и повторить. Но допускаю, что гиперссылки могут быть не единственной причиной.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

БМВ,если с пустым файлом, у меня работает) Только нужно было чтобы он не у папки добавлял название в конце, а у самого файла  :D . Но блин даже несмотря на то что сохраняется вордовский файл, открыть его не получается, пишет «проблема с содержимым».

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

Off
Дмитрий(The_Prist) Щербаков, Дмитрий, возвращайте уж просто The_Prist. Я серьезно. Первая смена для меня шоком была. аватарку точно не перепутал, компетенции высокии  теже, но имя другое :-)

По вопросам из тем форума, личку не читаю.

 

Kentavrik7

Пользователь

Сообщений: 433
Регистрация: 13.04.2016

#9

10.07.2018 13:04:09

Код
Private Sub CommandButton1_Click()
  Dim s1
s1 = Mid(ActiveDocument.Path, 1, InStrRev(ActiveDocument.Path, ""))
    MkDir TextBox1.Value
    ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & ActiveDocument.Name, FileFormat:=wdFormatFlatXMLTemplateMacroEnabled
End Sub

Да блин что не так(( Выводит теперь ошибку «5152»

Изменено: Kentavrik710.07.2018 13:05:44

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

Kentavrik7, проверять нет желания, но вы сохраняете файл FileFormat:=wdFormatFlatXMLTemplateMacroEnabled не меняя расширения, которое наследуется от ActiveDocument.Name но это уже не имеет отношения к созданию папаки

https://msdn.microsoft.com/en-us/vba/word-vba/articles/wdsaveformat-enumeration-word

Изменено: БМВ10.07.2018 13:21:14

По вопросам из тем форума, личку не читаю.

 

StoTisteg

Пользователь

Сообщений: 441
Регистрация: 07.05.2018

Kentavrik7, попробуйте вообще не указывать никакой формат.

 

Kentavrik7

Пользователь

Сообщений: 433
Регистрация: 13.04.2016

#12

10.07.2018 14:02:09

БМВ, StoTisteg, спасибо вот так работает

Код
Private Sub CommandButton1_Click()
  Dim s1
s1 = Mid(ActiveDocument.Path, 1, InStrRev(ActiveDocument.Path, ""))
    MkDir s1 & TextBox1.Value
    ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & ActiveDocument.Name
End Sub

Теперь создает папку и копирует туда файл. Подскажите как изменять имя файла самого, чтобы допустим если там написано какое то слово ( Чаще всего город ) переписать ему месяц ( из «Азов март» сделать «Азов апрель») исходя из текстбокса

Изменено: Kentavrik710.07.2018 14:02:20

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

Если нет гарантии что место положение упоминания о месяце фиксировано, то я б сперва 12 раз заменил месяц из списка на месяц из текстбокса. На первый и второй пробел ориентироваться опасно, на последний возможно тоже :-(

По вопросам из тем форума, личку не читаю.

 

БМВ, например, если я все заголовки заменю на «Кузнецк_Раздел 1,2_сентябрь 2014_Вариация»
По нижнему подчеркиванию как можно поменять ?

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#15

10.07.2018 14:43:41

да я б все равно сделал  типа так

Код
Months=array("январь",..... ….,"декабрь")
Name = ActiveDocument.Name
for I = 0 to 11
 Name = replace(name,Months(I),TextBox1.Value)
next 

По вопросам из тем форума, личку не читаю.

 

Kentavrik7

Пользователь

Сообщений: 433
Регистрация: 13.04.2016

#16

10.07.2018 14:53:49

БМВ, В общий код к сожалению интегрировать не получилось. Может я не так что то делаю

Код
Private Sub CommandButton1_Click()
  Dim s1
s1 = Mid(ActiveDocument.Path, 1, InStrRev(ActiveDocument.Path, ""))
    MkDir s1 & TextBox1.Value
    Months = Array("январь", "Февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь")
Name = ActiveDocument.Name
For I = 0 To 11
 Name = Replace(Name, Months(I), TextBox1.Value)
Next
    ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & ActiveDocument.Name
    MsgBox "Папка создана"
End Sub

Вопрос такой в строке

Код
ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & ActiveDocument.Name

Если ничего не менять, то он сохраняет файл с исходным именем.
Если сделать так

Код
ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value

Он меняет имя но сохраняет его поверх папки, а не в нее. Логика вообще не понятная, и как это победить

Изменено: Kentavrik710.07.2018 14:53:58

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#17

10.07.2018 15:31:57

А если так?

Код
ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & Name

:-)

Да  и с Февраль осторожнее . Чуствительность к регистру имеется.

Изменено: БМВ10.07.2018 15:34:13

По вопросам из тем форума, личку не читаю.

 

Kentavrik7

Пользователь

Сообщений: 433
Регистрация: 13.04.2016

#18

10.07.2018 15:53:04

БМВ,

Код
Private Sub CommandButton1_Click()
  Dim s1
s1 = Mid(ActiveDocument.Path, 1, InStrRev(ActiveDocument.Path, ""))
    MkDir s1 & TextBox1.Value
    Months = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь")
Name = ActiveDocument.Name
For I = 0 To 11
 Name = Replace(Name, Months(I), TextBox1.Value)
Next
    ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & Name
    MsgBox "Папка создана"
End Sub

так не получается, ошибка что-то

Изменено: Kentavrik710.07.2018 15:53:15

 

Kentavrik7

Пользователь

Сообщений: 433
Регистрация: 13.04.2016

#19

10.07.2018 15:56:47

БМВ, или же нужно как то в цикл это все?

Код
   Dim Months
    Dim OldFileName As String
    Dim NewFileName As String
    Dim i As Integer
    
    OldFileName = "Кузнецк_Раздел 1,2_сентябрь 2018_Вариация"
    Months = Array("январь", "февраль", "декабрь", "сентябрь")
   
 For i = 0 To UBound(Months)
        If (InStr(OldFileName, Months(i)) > 0) Then
            If i <> UBound(Months) Then
                NewFileName = Replace(OldFileName, Months(i), Months(i + 1))
                MsgBox NewFileName
                Exit For
             
             Else 'если последний месяц - перескакиваем на первый элемент массива
                NewFileName = Replace(OldFileName, Months(i), Months(0))
                MsgBox NewFileName
                Exit For
             End If
        End If
    Next i

Изменено: Kentavrik710.07.2018 15:56:53

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#20

10.07.2018 16:09:25

Цитата
Kentavrik7 написал:
так не получается, ошибка что-то

что при этом в Name?

По вопросам из тем форума, личку не читаю.

 

БМВ, Ярославль_Разделы 2,3_Апрель_ 2018

Изменено: Kentavrik710.07.2018 16:13:00

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#22

10.07.2018 16:20:12

Код
Private Sub CommandButton1_Click()
  Dim s1
s1 = Mid(ActiveDocument.Path, 1, InStrRev(ActiveDocument.Path, ""))
    MkDir s1 & TextBox1.Value
    Months = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь")
NewName = ActiveDocument.Name
For i = 0 To 11
 Name = Replace(NewName, Months(i), TextBox1.Value)
Next
    ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "" & NewName
    MsgBox "Папка создана"
End Sub

По вопросам из тем форума, личку не читаю.

 

БМВ, Выдает ошибку на Name

Изменено: Kentavrik710.07.2018 16:25:52

 

sokol92

Пользователь

Сообщений: 4445
Регистрация: 10.09.2017

Здравствуйте, Михаил! Боюсь, что имя Name для переменной в Word не подходит.

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

черт пропустил  там NewName должно быть везде.

По вопросам из тем форума, личку не читаю.

 

БМВ, sokol92, Отлично! Спасибо работает ))))
Большая вам благодарность!!!.
Маленький вопрос еще) Если будет необходимо называть папки
05_Май
06_Июнь
07_Июль
Можно ли чтобы в названия файла не шли три первые символа?

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#27

10.07.2018 16:52:31

sokol92,  Владимир, приветствую. Правильно боитесь :-) .

Цитата
Kentavrik7 написал:
Можно ли чтобы в названия файла не шли три первые символа?

не понял, просто и имени вырезать первые три?

NewName=Mid(NewName,4,256)

По вопросам из тем форума, личку не читаю.

 

БМВ,Ну или как то сделать чтобы только месяц тянулся. Сейчас если попробовать внести в текст бокс 05_Май
он из этого
Ярославль_Разделы 2,3_Апрель_ 2018
делает вот так
Ярославль_Разделы 2,3_05_05_Май_ 2018

Изменено: Kentavrik710.07.2018 17:06:32

 

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#29

10.07.2018 17:05:21

Цитата
Kentavrik7 написал:
Ну или как то сделать чтобы только месяц тянулся.

Mid(TextBox1.Value,4,256)

По вопросам из тем форума, личку не читаю.

 

Kentavrik7

Пользователь

Сообщений: 433
Регистрация: 13.04.2016

#30

10.07.2018 17:09:31

БМВ,Вы гений, спасибо большое)))  

  • Функции WinAPI
  • Средства Windows
  • Работа с файлами

Как известно, VBA-функция MkDir может создать только папку в существующем каталоге (папке).

 
Например, код MkDir «C:Папка» отработает корректно в любом случае (создаст указанную папку),
а код MkDir «C:ПапкаПодпапкаКаталог» выдаст ошибку Run-time error ’76’: Path not found
(потому что невозможно создать каталог Подпапка в несуществующем ещё каталоге Папка)

 
Можно, конечно, использовать несколько функций MkDir подряд — но это усложняет код.

 
Самый простой способ решения проблемы — использование WinAPI-функции SHCreateDirectoryEx, которая может создать все нужные папки и подпапки за один запуск.

Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
                                     (ByVal hwnd As Long, ByVal pszPath As String, _
                                      ByVal psa As Any) As Long
 
 
Sub CreateFolderWithSubfolders(ByVal ПутьСоздаваемойПапки$)
    ' функция получает в качестве параметра путь к папке
    ' если такой папки ещё нет - она создаётся
    ' может создаваться сразу несколько подпапок
    If Len(Dir(ПутьСоздаваемойПапки$, vbDirectory)) = 0 Then    ' если папка отсутствует
        SHCreateDirectoryEx Application.hwnd, ПутьСоздаваемойПапки$, ByVal 0&    ' создаём путь
    End If
End Sub

Пример использования функции SHCreateDirectoryEx:

Sub ПримерИспользованияCreateFolderWithSubfolders()
    ' этот макрос создаст на диске C папку "Создаваемая папка",
    ' в ней - подпапку "Подпапка", а в последней - подпапку 1234
    Путь = "C:Создаваемая папкаПодпапка1234"
 
    CreateFolderWithSubfolders Путь
End Sub
  • 69892 просмотра

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Creating, deleting and renaming folders is a common requirement when automating processes with VBA.  The code snippets below should be sufficient to complete the most common folder tasks.

All the code examples below use the built-in Dir() function and its derivatives.  The File System Object methods are not covered in this post but will be covered at a future point.

Check if a folder exists

Referencing a folder which does not exist will result in an error, therefore it is often necessary to check if a folder exists before carrying out any other actions.

'Check if a folder exists
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsFolder"

If Dir(folderPath, vbDirectory) <> "" Then

    'Insert action for if the folder exists
    'This example prints to the immediate window
    Debug.Print folderPath & " exists."

Else

    'Insert actions if the folder does not exist
    'This example prints to the immediate window
    Debug.Print folderPath & " does not exist."

End If

vbDirectory is the attribute of a folder.  The code above can be adapted to check for other types of files too.

VBA Name of attribute Enumerator Description
vbNormal 0 Files with no attributes (default setting)
vbReadOnly 1 Read-only files
vbHidden 2 Hidden files
vbSystem 4 System files
vbVolume 8 Volume label
vbDirectory 16 Directories

For checking folder existence within another procedure, it is often easier to have a reusable function, which can be called upon when required.

'Reusable function to check if a folder exists
Function doesFolderExist(folderPath) As Boolean

DoesFolderExist = Dir(folderPath, vbDirectory) <> ""

End Function

The following VBA code calls the doesFolderExist function from above and prints True (the folder exists) or False (the folder does not exist) to the Immediate window.

'Call the reusable function to check for folder existence
Debug.Print doesFolderExist("C:UsersmarksDocumentsFolder")

The following VBA code calls the doesFolderExist function from above for use within an If statement.

'Check if a folder exists calling the doesFolderExist function
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsFolder"

If doesFolderExist(folderPath) = True Then

    'Insert action for if the folder exists
    'This example prints to the immediate window
    Debug.Print folderPath & " exists."

Else

    'Insert actions if the folder does not exist
    'This example prints to the immediate window
    Debug.Print folderPath & " does not exist."

End If

Create a new folder

The VBA code below will create a new folder.  If the folder already exists, it will not overwrite it, but it will display an error.  The function will only create the last folder in the file path, all the parent folders must already exist.

'Create a new folder
MkDir "C:UsersmarksDocumentsNew folder"

The avoid an error, the code below will check if a folder exists before trying to create it.

'Create a folder if it does not already exist, if it does, do nothing 
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsNew Folder"

'Check if the folder exists
If Dir(folderPath, vbDirectory) = "" Then

    'Folder does not exist, so create it
    MkDir folderPath

End If

As the Dir() function will only create a single folder, the code below loops through the individual folder names in the path and calls the Dir() function to create any missing folders and subfolders.

'Create all the folders in a folder path
Dim folderPath As String
Dim individualFolders() As String
Dim tempFolderPath As String
Dim arrayElement As Variant

'The desired folder path
folderPath = "C:UsersmarksDocumentsNew FolderNew FolderNew FolderNew Folder"

'Split the folder path into individual folder names
individualFolders = Split(folderPath, "")

'Loop though each individual folder name
For Each arrayElement In individualFolders

'Build string of folder path
    tempFolderPath = tempFolderPath & arrayElement & ""
 
    'If folder does not exist, then create it
    If Dir(tempFolderPath, vbDirectory) = "" Then
 
        MkDir tempFolderPath
 
     End If
 
Next arrayElement

Delete a folder

The RmDir function will delete a folder.  However, it is limited as it will only delete an empty folder.  All the files within the folder will need to be deleted first.  Using the File System Object method (which is not covered in this post) it is possible to delete folders and their contents.

'Delete a folder
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsDelete Folder"

'Ensure the folder path as a "" at the end of the string
'Required for deleting the files using wildcards
If Right(folderPath, 1) <> "" Then folderPath = folderPath & ""

'Use wildcards to delete all the files in the folder
Kill folderPath & "*.*"

'Delete the now empty folder
RmDir folderPath

If the folder does not exist the RmDir function will display an error.  Refer to the first section of this post to check for existence

Rename a folder

The VBA code below will re-name a folder, and even move the contents of the entire folder to another location.

'Rename a folder
Name "C:UsersmarksDocumentsFolder" As "C:UsersmarksDocumentsRenamed Folder"

To use this example code, it may be necessary to check if the old folder name exists and the new folder name does not exist.


Headshot Round

About the author

Hey, I’m Mark, and I run Excel Off The Grid.

My parents tell me that at the age of 7 I declared I was going to become a qualified accountant. I was either psychic or had no imagination, as that is exactly what happened. However, it wasn’t until I was 35 that my journey really began.

In 2015, I started a new job, for which I was regularly working after 10pm. As a result, I rarely saw my children during the week. So, I started searching for the secrets to automating Excel. I discovered that by building a small number of simple tools, I could combine them together in different ways to automate nearly all my regular tasks. This meant I could work less hours (and I got pay raises!). Today, I teach these techniques to other professionals in our training program so they too can spend less time at work (and more time with their children and doing the things they love).


Do you need help adapting this post to your needs?

I’m guessing the examples in this post don’t exactly match your situation. We all use Excel differently, so it’s impossible to write a post that will meet everybody’s needs. By taking the time to understand the techniques and principles in this post (and elsewhere on this site), you should be able to adapt it to your needs.

But, if you’re still struggling you should:

  1. Read other blogs, or watch YouTube videos on the same topic. You will benefit much more by discovering your own solutions.
  2. Ask the ‘Excel Ninja’ in your office. It’s amazing what things other people know.
  3. Ask a question in a forum like Mr Excel, or the Microsoft Answers Community. Remember, the people on these forums are generally giving their time for free. So take care to craft your question, make sure it’s clear and concise.  List all the things you’ve tried, and provide screenshots, code segments and example workbooks.
  4. Use Excel Rescue, who are my consultancy partner. They help by providing solutions to smaller Excel problems.

What next?
Don’t go yet, there is plenty more to learn on Excel Off The Grid.  Check out the latest posts:

Понравилась статья? Поделить с друзьями:
  • Vba word случайное число
  • Vba word скопировать весь текст
  • Vba word символ пробела
  • Vba word символ переноса строки
  • Vba word свойства tables