Страницы: 1
RSS
Создание папки в тойже директории
 
Столкнулась с проблемой  
 
Макрос должен создавать папку в той же директории где лежит этот файл  
Не могу решить проблему  
 
Макрос должен создавать папку в той же директории где лежит этот файл  
Наименование созданной папки дб такое (состоять из)  - наименование текущего АКТИВНОГО листа / значение С4 тек листа / значение D4 тек листа  
 
Нашла макрос но он не подходит под условия  
Sub Papka()  
'pathDir = "D:\" & Sheets("1").Range("C4").Range("D4").Value  
pathDir = "D:\" & Sheets("1").Range("C4").Value  
If Dir(pathDir, vbDirectory) = "" Then  
MkDir pathDir  
End If  
CreateObject("Shell.Application").Explore pathDir  
End Sub
 
pathDir = activesheet.name & "_" & [C4] & "_" & [D4]
 
ващ код вставила получилось так но не работает  
 
Sub Papka()  
pathDir = ActiveSheet.Name & "_" & [C4] & "_" & [D4]
If Dir(pathDir, vbDirectory) = "" Then  
MkDir pathDir  
End If  
CreateObject("Shell.Application").Explore pathDir  
End Sub
 
Сорри  
 
pathDir = activeworkbook.path & "\" & activesheet.name & "_" & [C4] & "_" & [D4]
 
вот так получилось  
но создает на диске D а нужно чтоб в директории где файл лежит  
 
Sub Papka()  
pathDir = "D:\" & ActiveSheet.Name & "_" & [C4] & "_" & [D4].Value
If Dir(pathDir, vbDirectory) = "" Then  
MkDir pathDir  
End If  
CreateObject("Shell.Application").Explore pathDir  
End Sub
 
Sub Papka()  
pathDir = ActiveWorkbook.Path & "\" & ActiveSheet.Name & "_" & [C4] & "_" & [D4]
If Dir(pathDir, vbDirectory) = "" Then  
MkDir pathDir  
End If  
CreateObject("Shell.Application").Explore pathDir  
End Sub  
 
сейчас заработало СПАСИБО !!!
 
блин поторопилась еще надо добавить
 
Sub Papka()  
pathDir = ActiveWorkbook.Path & "ПЕРЕПИСКА С КЛИЕНТАМИ""\" & ActiveSheet.Name & "_" & [C4] & "_" & [D4]
If Dir(pathDir, vbDirectory) = "" Then  
MkDir pathDir  
End If  
CreateObject("Shell.Application").Explore pathDir  
End Sub  
 
в выбранной директории создать папку ПЕРЕПИСКА С КЛИЕНТАМИ и туда складывать так сделала но не получилось ...
 
В какой "выбранной"? Если в той, что была создана на первом этапе, то  
 
Sub Papka()  
pathdir = ActiveWorkbook.Path & "\" & ActiveSheet.Name & "_" & [C4] & "_" & [D4]
If Dir(pathdir, vbDirectory) = "" Then MkDir pathdir  
pathdir = pathdir & "\" & "ПЕРЕПИСКА С КЛИЕНТАМИ"  
If Dir(pathdir, vbDirectory) = "" Then MkDir pathdir  
 
CreateObject("Shell.Application").Explore pathdir  
End Sub
 
нет сначала создаем папку общую ПЕРЕПИСКА С КЛИЕНТАМИ а потом уже в нее подпапку с нименованием из активного листа
 
нет сначала создаем папку общую ПЕРЕПИСКА С КЛИЕНТАМИ а потом уже в нее подпапку с нименованием из активного листа
 
Sub Papka()  
pathdir = ActiveWorkbook.Path & "\" & "ÏÅÐÅÏÈÑÊÀ Ñ ÊËÈÅÍÒÀÌÈ"  
If Dir(pathdir, vbDirectory) = "" Then MkDir pathdir  
pathdir = pathdir & "\" & ActiveSheet.Name & "_" & [C4] & "_" & [D4]
If Dir(pathdir, vbDirectory) = "" Then MkDir pathdir  
 
CreateObject("Shell.Application").Explore pathdir  
End Sub  
 
вот так сделала получилось ЕЩЕ РАЗ БЛАГОДАРЮ за помощь !
 
Sub Papka()    
pathdir = ActiveWorkbook.Path & "\" & "ПЕРЕПИСКА С КЛИЕНТАМИ"    
If Dir(pathdir, vbDirectory) = "" Then MkDir pathdir    
pathdir = pathdir & "\" & ActiveSheet.Name & "_" & [C4] & "_" & [D4]
If Dir(pathdir, vbDirectory) = "" Then MkDir pathdir    
   
CreateObject("Shell.Application").Explore pathdir    
End Sub    
 
так правильно
 
еще по этой теме статейку нашла http://excelvba.ru/code/MkDir  
 
заготовка  
Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _    
                                    (ByVal hwnd As Long, ByVal pszPath As String, _    
                                     ByVal psa As Any) As Long    
   
   
'Sub ПримерИспользованияCreateFolderWithSubfolders()    
   ' этот макрос создаст на диске C папку "Создаваемая папка",    
  ' в ней - подпапку "Подпапка", а в последней - подпапку 1234    
  'Путь = "C:\Создаваемая папка\Подпапка\1234\"    
     
   'CreateFolderWithSubfolders Путь    
'End Sub    
   
Sub CreateFolderWithSubfolders()    
   ' функция получает в качестве параметра путь к папке    
  ' если такой папки ещё нет - она создаётся    
  ' может создаваться сразу несколько подпапок    
  Путь = "C:\Создаваемая папка\Подпапка\1234\"    
  If Len(Dir(Путь, vbDirectory)) = 0 Then    ' если папка отсутствует    
      SHCreateDirectoryEx Application.hwnd, Путь, ByVal 0&    ' создаём путь    
  End If    
End Sub
Страницы: 1
Читают тему
Наверх