Deschidere secventiala

Închis
ccirtina
Mesaje: 280
Membru din: Lun Oct 11, 2010 9:49 pm
Localitate: Craiova

Deschidere secventiala

Mesaj de ccirtina » Vin Feb 25, 2011 10:39 pm

word2003
Am 100 fisiere.
Care este codul VBA care sa deschida 10 fisiere sa faca o pauza de 4secunde apoi sa deschida urmatoarele 10 fisiere si iar sa faca 4 secunde pauza apoi sa deschida urmatoarele 10 fisiere si iar sa faca 4 secunde pauza s.a.m.d. pana epuizeaza toate cele 100 de fisiere.

Dr.Windows
Moderator
Moderator
Mesaje: 4570
Membru din: Vin Iul 31, 2009 7:32 am

Re: Deschidere secventiala

Mesaj de Dr.Windows » Vin Apr 22, 2011 8:56 pm

Daca problema mai este de actualitate, poti folosi urmatorul cod:

Cod: Selectaţi tot

Sub OpenFiles()
    Dim cPath, FullPath As String
    Dim x As Variant
    
    cPath = "C:\DrExcel.ro\"
    
    FullPath = cPath + "*.doc"
    x = GetFileList(FullPath)
    Select Case IsArray(x)
        Case True 'files found
            For i = LBound(x) To UBound(x)
                Application.Documents.Open (cPath & x(i))
                If (i Mod 10) = 0 Then
                    Sleep (10000)
                End If
            Next i
        Case False 'no files found
            MsgBox "Nu am gasit nici un fisier care sa respecte modelul: " & lcFile
    End Select
End Sub
Codul se mai bazeaza pe o declaratie care trebuie sa apara la inceputul modulului unde vei pune codul (pentru functia SLEEP):

Cod: Selectaţi tot

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Si pe o functie suplimentara care sa returneze fisierele gasite intr-un folder sub forma unui array:

Cod: Selectaţi tot

Function GetFileList(FileSpec As String) As Variant
    '   Returns an array of filenames that match FileSpec
    '   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
NoFilesFound:
    GetFileList = False
End Function
Ai atasat documentul "master" care poate face deschiderea automata a tuturor fisierelor dintr-un folde specificat, facand o "pauza de deschidere" la fiecare 10 fisiere.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

Închis

Înapoi la “Visual Basic for Application (VBA) - Intrebari tehnice”