| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA Поочередное открытие файлов DWG из нужной папки ???

VBA Поочередное открытие файлов DWG из нужной папки ???

Ответ
Поиск в этой теме
Непрочитано 05.03.2005, 16:07 #1
VBA Поочередное открытие файлов DWG из нужной папки ???
sf
 
Регистрация: 05.03.2005
Сообщений: 4

Уважаемые форумчане, спецы VBA.
Может кто поможет. Заранее спасибо.

Нужно
1. Поочередное открывать файловы DWG из нужной папки и подпапок ???
2. для каждого открытого файла перейти в модель и выполнить команду explode, потом во все layout тоже explode
Просмотров: 9384
 
Автор темы   Непрочитано 09.03.2005, 09:24
#2
sf


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


Как получить список файлов DWG в текущей папке и подпапках
sf вне форума  
 
Непрочитано 19.03.2005, 10:32
#3
FWA

Программирование
 
Регистрация: 16.02.2005
г.Минусинск
Сообщений: 3


Смотри функцию dos_dir из библиотеки DOSLib.
FWA вне форума  
 
Непрочитано 20.03.2005, 12:46
#4
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


Вижу что никто не отвечает. Это потому что вопрос включает в себя несколько различных и требует большого количества кода и обяснений, которые ты и так можешь получить в Help и в виде готовых примеров в интернете.

1. Как вызвать диалоговое окно поиска директорий.
2. Как найти все нужные файлы в директории (поддиректориях)
3. Как поочередно открывать файлы делать там определенные действия и закрывать их.

Как тоже начинающий в VBA покажу как сделать 1. и частично 2. Поочережное открытие файлов труда не представляет.

Для вызова окна выбора директории надо воспользоваться стандарными API функциями, а затем найти файлы с нужным расширением с помощью функции Dir. Для поиска файлов в поддиректроиях надо сначала получить их список с помощью функции Dir с аргументом vbDirectory (в этом коде не реализовано). Первая часть кода ессно из интернету:

Код:
[Выделить все]
Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Type BrowseInfo
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszINSTRUCTIONS As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
    ByVal pidl As Long, _
    ByVal pszBuffer As String) As Long

Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
    lpBrowseInfo As BrowseInfo) As Long

Function BrowseFolder(Optional Caption As String = "") As String

    Dim BrowseInfo As BrowseInfo
    Dim FolderName As String
    Dim ID As Long
    Dim Res As Long

    With BrowseInfo
        .hOwner = 0
        .pidlRoot = 0
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = Caption
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpfn = 0
    End With

    FolderName = String$(MAX_PATH, vbNullChar)

    ID = SHBrowseForFolderA(BrowseInfo)

    If ID Then
        Res = SHGetPathFromIDListA(ID, FolderName)
        If Res Then
            BrowseFolder = Left$(FolderName, InStr(FolderName, _
                vbNullChar) - 1)
        End If
        End If

End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++
   ' ŌÓĶŹÖČß ĀŪĮĪŠĄ ĀŃÅÕ ŌĄÉĖĪĀ ČĒ ÄČŠÅŹŅĪŠČČ
'+++++++++++++++++++++++++++++++++++++++++++++++++++++
' Ōóķźöč˙ ļīėó÷ąåņ ā źą÷åńņāå ąšćóģåķņīā čńźīģīå šąńųčšåķčå
' ōąéėīā č ķąäļčńü ā äčąėīćīāīģ īźķå. Ā ļšīöåńńå šąįīņū
' āūēūāąåņń˙ ōóķöč˙ BrowseFolder āūēūāąžłą˙ äčąėīćīāīå īźķī
' āūįīšą äčšåźņīščé. Ļšč āūįīšå äčšåźņīščč  č ķąõīęäåķčč
' ņąģ ōąéėīā ń čńźīģūģ šąńųčšåķčåģ  ōóķöč˙ GetDirectoryFiles
' āīēāšąłąåņ äčķąģč÷åńźčé ģąńńčā ń ļīėķūģč ļóņ˙ģč ķą ōąéėū.
' Ā ļšīņčāķīģ ńėó÷ąå äčķąģč÷åńźčé ģąńńčā ń ļóńņīé ńņšīźīé
' ā ļåšāīģ żėåģåķņå.

' ĄŠĆÓĢÅĶŅŪ:
' Ext - šąńųčšåķčå ōąéėīā
' Writing - Ķąäļčńü ā īźķå
'
' ĻÅŠÅĢÅĶĶŪÅ:
' dirName - ķąēāąķčå äčšåźņīščč
' searchName - ńņšīźą ļīčńźą ōąéėīā ń īļšåäåėåķķūģ šąńųčšåķčåģ
' fileName - čģ˙ ķąéäåķķīćī ōąéėą
' fileArray() - īäķīģåķšūé äčķąģč÷åńźčé ģąńńčā ń ļóņ˙ģč
' xCount - ń÷åņ÷čź äė˙ čēģåķåķč˙ šąēģåšķīńņč ģąńńčāą

Function GetDirectoryFiles(Ext, Writing As String) As Variant
Dim dirName, searchName, fileName As String
Dim fileArray() As String
Dim xCount As Long

dirName = BrowseFolder(Writing) ' Ļīėó÷čņü ķąēāąķčå äčšåźņīščč

    xCount = 0 ' ķą÷ąėüķīå ńīńņī˙ķčå ń÷åņ÷čźą
        If dirName <> "" Then ' åńėč äčšåźņīč˙ āūįšąķą
            searchName = dirName & "\*." & Ext ' ńōīšģčšīāąņü ńņšīźó ļīčńźą
            fileName = Dir(searchName) ' čńźąņü ļåšāūé ōąéė ā äčšåźņīščč
            If fileName <> "" Then ' åńėč ōąéė ķąéäåķ
                ReDim fileArray(xCount) ' čēģåķčņü šąēģåšķīńņü ģąńńčāą
                fileArray(xCount) = dirName & "\" & fileName ' äīįąāčņü ōąéė č ļóņü
            End If
            
                Do While fileName <> "" ' āūļīėķ˙ņü äī ļīńėåäķåćī ōąéėą
                    xCount = 1 + xCount ' óāåėč÷čņü ń÷åņ÷čź
                    fileName = Dir() ' ķąéņč ńėåäóžłčé ōąéė
                        If fileName <> "" Then ' åńėč ōąéė ķąéäåķ
                            ReDim Preserve fileArray(xCount) ' óāåėč÷čņü šąēģåšķīńņü ģąńńčāą
                            fileArray(xCount) = dirName & "\" & fileName ' äīįąāčņ ōąéė č ļóņü
                        End If
                Loop
            
        Else ' åńėč äčšåźņīšč˙ ķå āūįšąķą
        ReDim fileArray(xCount) ' čēģåķčņü šąģåšķīńņü ģąńńčāą äī īäķīćī żėåģåķņą
        fileArray(xCount) = "" ' äīįąāčņü ā ģąńńčā ļóńņóž ńņšīźó
        End If
        
    GetDirectoryFiles = fileArray ' āīēāšąłąåģīå ēķą÷åķčå ōóķźöčč

End Function
Если вызвать потом функцию GetDirectoryFiles в процедуре:
Код:
[Выделить все]
Sub DirTest()
Dim fArr() As String
fArr = GetDirectoryFiles("dwg", "Select *.dwg files")
End Sub
И посмотреть в окне Locals состояние переменной fArr то увидим (см. Картинку). Русские пояснения к сожалению получились "кракозябрами"
[ATTACH]1111312005.JPG[/ATTACH]
{Smirnoff} вне форума  
 
Непрочитано 21.03.2005, 09:27
#5
Lenich

Опер дир
 
Регистрация: 28.04.2004
Москва
Сообщений: 291


Fantomas,
Цитата:
Вижу что никто не отвечает
Эту и другие подобные дубликаты тем sf поднимал в autocad.ru, там практически усё разжевали.
Lenich вне форума  
 
Непрочитано 21.03.2005, 11:22
#6
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


>Lenich
Вот его постинг на autocad.ru:
Цитата:
Есть компонент commonDialog, но он позвроляет выбирать только файлы.

А нужно выбрать директорию. Как это можно сделать на VBA?
Ответов 0.

Это не совсем хорошо, понятно что если на Google набрать "VBA browse for folder" то получишь по крайней мере 50 удобоваримых примеров. Однако многие знают и могли хотя бы направить человека на правильный путь. Я то сам месяц назад за VBA сел, поэтому и не лез с непрофессиональными советами...
{Smirnoff} вне форума  
 
Непрочитано 21.03.2005, 13:05
#7
Lenich

Опер дир
 
Регистрация: 28.04.2004
Москва
Сообщений: 291


Fantomas,
Ответов ноль в этом постинге, а в других, которые были ранее !?! Как раз ваш пример (функция BrowseFolder один в один, глубже не смотрел) и приведен, правда ссылкой.

Делать темы с одним и тем же содержанием (да ещё и дублировать в течении пары дней) - это не хорошо ИМХО.
Lenich вне форума  
 
Непрочитано 21.03.2005, 14:50
#8
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


>Lenich

То что написано с коментариями полностью моё самостоятельное творчество. Однако из-за тривиальности задачи, может быть очень похоже на множество других. Этого конечно не скажешь о BrowseFolder, ссылку не привел только потому что уже не помнил с какого сайта взял, скачал сразу кучу примеров и пробывал по одному...

Сдесь я вижу один его постинг на эту тему.
{Smirnoff} вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA Поочередное открытие файлов DWG из нужной папки ???

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск