Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Курилка
Страницы: 1 2 След.
RSS
Исправить код для создания папки, VBA WORD
 
#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
 
 
 
#2
10.07.2018 12:09:17
Цитата
Kentavrik7 написал:
(Word)
А причем ту форум по Excel, если вопрос по Word?
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#3
10.07.2018 12:12:23
Цитата
Kentavrik7 написал:
папка создавалась на уровень выше но такого не происходит
потому что такого просто нет в коде. Там берется путь к папке с активным документом. Чтобы определить папку выше можно просто использовать InStrRev для поиска последнего слеша:
Код
s1 = Mid(ActiveDocument.Path,1,instrrev(ActiveDocument.Path,"\"))

Цитата
Kentavrik7 написал:
но он просто создает папку
уберите On Error Resume Next и увидите почему. Что-то явно не дает его сохранить. Разбирайтесь с самой ошибкой.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#4
10.07.2018 12:17:10
Дмитрий(The_Prist) Щербаков, Спасибо. Создает верно папку. А вот с сохранением ошибка Run-time Error '4198' ошибка команды
 
 
 
#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
По вопросам из тем форума, личку не читаю.
 
 
 
#6
10.07.2018 12:34:10
Цитата
Kentavrik7 написал:
А вот с сохранением ошибка
А Гугл что по этому поводу говорит? Такие ошибки возникают если есть некие повреждения структуры документа. Наблюдалось такое, если в Word есть гиперссылки. Попробуйте удалить гиперссылки(если они есть) и повторить. Но допускаю, что гиперссылки могут быть не единственной причиной.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#7
10.07.2018 12:45:17
БМВ,если с пустым файлом, у меня работает) Только нужно было чтобы он не у папки добавлял название в конце, а у самого файла  :D . Но блин даже несмотря на то что сохраняется вордовский файл, открыть его не получается, пишет "проблема с содержимым".
 
 
 
#8
10.07.2018 12:52:03
Off
Дмитрий(The_Prist) Щербаков, Дмитрий, возвращайте уж просто The_Prist. Я серьезно. Первая смена для меня шоком была. аватарку точно не перепутал, компетенции высокии  теже, но имя другое :-)
По вопросам из тем форума, личку не читаю.
 
 
 
#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"
Изменено: Kentavrik7 - 10.07.2018 13:05:44
 
 
 
#10
10.07.2018 13:12:17
Kentavrik7, проверять нет желания, но вы сохраняете файл FileFormat:=wdFormatFlatXMLTemplateMacroEnabled не меняя расширения, которое наследуется от ActiveDocument.Name но это уже не имеет отношения к созданию папаки

https://msdn.microsoft.com/en-us/vba/word-vba/articles/wdsaveformat-enumeration-word
Изменено: БМВ - 10.07.2018 13:21:14
По вопросам из тем форума, личку не читаю.
 
 
 
#11
10.07.2018 13:49:45
Kentavrik7, попробуйте вообще не указывать никакой формат.
 
 
 
#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
Теперь создает папку и копирует туда файл. Подскажите как изменять имя файла самого, чтобы допустим если там написано какое то слово ( Чаще всего город ) переписать ему месяц ( из "Азов март" сделать "Азов апрель") исходя из текстбокса
Изменено: Kentavrik7 - 10.07.2018 14:02:20
 
 
 
#13
10.07.2018 14:11:56
Если нет гарантии что место положение упоминания о месяце фиксировано, то я б сперва 12 раз заменил месяц из списка на месяц из текстбокса. На первый и второй пробел ориентироваться опасно, на последний возможно тоже :-(
По вопросам из тем форума, личку не читаю.
 
 
 
#14
10.07.2018 14:17:04
БМВ, например, если я все заголовки заменю на "Кузнецк_Раздел 1,2_сентябрь 2014_Вариация"
По нижнему подчеркиванию как можно поменять ?
 
 
 
#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
По вопросам из тем форума, личку не читаю.
 
 
 
#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
Он меняет имя но сохраняет его поверх папки, а не в нее. Логика вообще не понятная, и как это победить
Изменено: Kentavrik7 - 10.07.2018 14:53:58
 
 
 
#17
10.07.2018 15:31:57
А если так?
Код
ActiveDocument.SaveAs FileName:=s1 & TextBox1.Value & "\" & Name

:-)

Да  и с Февраль осторожнее . Чуствительность к регистру имеется.
Изменено: БМВ - 10.07.2018 15:34:13
По вопросам из тем форума, личку не читаю.
 
 
 
#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
так не получается, ошибка что-то
Изменено: Kentavrik7 - 10.07.2018 15:53:15
 
 
 
#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
Изменено: Kentavrik7 - 10.07.2018 15:56:53
 
 
 
#20
10.07.2018 16:09:25
Цитата
Kentavrik7 написал:
так не получается, ошибка что-то
что при этом в Name?
По вопросам из тем форума, личку не читаю.
 
 
 
#21
10.07.2018 16:12:50
БМВ, Ярославль_Разделы 2,3_Апрель_ 2018
Изменено: Kentavrik7 - 10.07.2018 16:13:00
 
 
 
#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
По вопросам из тем форума, личку не читаю.
 
 
 
#23
10.07.2018 16:23:59
БМВ, Выдает ошибку на Name
Изменено: Kentavrik7 - 10.07.2018 16:25:52
 
 
 
#24
10.07.2018 16:37:48
Здравствуйте, Михаил! Боюсь, что имя Name для переменной в Word не подходит.
Владимир
 
 
 
#25
10.07.2018 16:38:23
черт пропустил  там NewName должно быть везде.
По вопросам из тем форума, личку не читаю.
 
 
 
#26
10.07.2018 16:48:38
БМВ, sokol92, Отлично! Спасибо работает ))))
Большая вам благодарность!!!.
Маленький вопрос еще) Если будет необходимо называть папки
05_Май
06_Июнь
07_Июль
Можно ли чтобы в названия файла не шли три первые символа?
 
 
 
#27
10.07.2018 16:52:31
sokol92,  Владимир, приветствую. Правильно боитесь :-) .

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

NewName=Mid(NewName,4,256)
По вопросам из тем форума, личку не читаю.
 
 
 
#28
10.07.2018 16:57:41
БМВ,Ну или как то сделать чтобы только месяц тянулся. Сейчас если попробовать внести в текст бокс 05_Май
он из этого
Ярославль_Разделы 2,3_Апрель_ 2018
делает вот так
Ярославль_Разделы 2,3_05_05_Май_ 2018
Изменено: Kentavrik7 - 10.07.2018 17:06:32
 
 
 
#29
10.07.2018 17:05:21
Цитата
Kentavrik7 написал:
Ну или как то сделать чтобы только месяц тянулся.
Mid(TextBox1.Value,4,256)
По вопросам из тем форума, личку не читаю.
 
 
 
#30
10.07.2018 17:09:31
БМВ,Вы гений, спасибо большое)))  
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх