VBA Tip - Acessando arquivo Texto - Text File access - Scripting Runtime object library - Scrrun.dll

Termo de Responsabilidade 

É possível usar o Scripting Runtime object library para manipular arquivos texto. O exemplo abaixo assume que seu projeto VBA acrescentou uma referência à biblioteca Microsoft Scripting Runtime. 

Sub WriteToTextFile()

Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream

Dim l As Long

    Set fs = New FileSystemObject

    Set f = fs.OpenTextFile("C:\FolderName\TextFileName.txt", _

        ForWriting, True)

    With f

        For l = 1 To 100

            .WriteLine "This is line number " & l

        Next l

        .Close

    End With

    Set f = Nothing

    Set fs = Nothing

End Sub

Sub AppendToTextFile()

Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream

Dim l As Long

    Set fs = New FileSystemObject

    Set f = fs.OpenTextFile("C:\FolderName\TextFileName.txt", _

        ForAppending, True)

    With f

        For l = 1 To 100

            .WriteLine "Added line number " & l

        Next l

        .Close

    End With

    Set f = Nothing

    Set fs = Nothing

End Sub

Sub ReadFromTextFile()

Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream

Dim l As Long

    Set fs = New FileSystemObject

    Set f = fs.OpenTextFile("C:\FolderName\TextFileName.txt", _

        ForReading, False)

    With f

        l = 0

        While Not .AtEndOfStream

            l = l + 1

            Cells(l, 5).Formula = .ReadLine

        Wend

        .Close

    End With

    Set f = Nothing

    Set fs = Nothing

End Sub

Tags: VBA, Tips, files, directory, folder, Scripting Runtime object library, Scrrun.dll, FileSystemObject, GetFiles, ChangeFileAttributes, 

VBA Tips - Alterando as propriedades dos arquivos e pastas - Setting File & Folder Attributes - Scripting Runtime object library - Scrrun.dll

Termo de Responsabilidade 

O objeto File e o objeto Folder posseum propriedades de atributo que podem ser usadas para ler ou definir seus respectivos atributos.

Function ChangeFileAttributes(strPath As String, _

                            Optional lngSetAttr As FileAttribute, _

                            Optional lngRemoveAttr As FileAttribute, _

                            Optional blnRecursive As Boolean) As Boolean

   

   ' This function takes a directory path, a value specifying file

   ' attributes to be set, a value specifying file attributes to be

   ' removed, and a flag that indicates whether it should be called

   ' recursively. It returns True unless an error occurs.

   

   Dim fsoSysObj      As FileSystemObject

   Dim fdrFolder      As Folder

   Dim fdrSubFolder   As Folder

   Dim filFile        As File

   

   ' Return new FileSystemObject.

   Set fsoSysObj = New FileSystemObject

   

   On Error Resume Next

   ' Get folder.

   Set fdrFolder = fsoSysObj.GetFolder(strPath)

   If Err <> 0 Then

      ' Incorrect path.

      

Let ChangeFileAttributes = False

      GoTo ChangeFileAttributes_End

   End If

   On Error GoTo 0

   

   ' If caller passed in attribute to set, set for all.

   If lngSetAttr Then

      For Each filFile In fdrFolder.Files

         If Not (filFile.Attributes And lngSetAttr) Then

            

Let filFile.Attributes = filFile.Attributes Or lngSetAttr

         End If

      Next

   End If

   

   ' If caller passed in attribute to remove, remove for all.

   If lngRemoveAttr Then

      For Each filFile In fdrFolder.Files

         If (filFile.Attributes And lngRemoveAttr) Then

            Let filFile.Attributes = filFile.Attributes - lngRemoveAttr

         End If

      Next

   End If

   

   ' If caller has set blnRecursive argument to True, then call

   ' function recursively.

   If blnRecursive Then

      ' Loop through subfolders.

      For Each fdrSubFolder In fdrFolder.SubFolders

         ' Call function with subfolder path.

         ChangeFileAttributes fdrSubFolder.Path, lngSetAttr, lngRemoveAttr, True

      Next

   End If

   

   Let ChangeFileAttributes = True

ChangeFileAttributes_End:

   Exit Function

End Function

A função ChangeFileAttributes leva quatro argumentos: o caminho para uma pasta, uma constante opcional que especifica os atributos para definir, uma constante opcional que especifica os atributos de remover, e um argumento opcional que especifica se a função deve ser chamado recursivamente.

Se o caminho da pasta passado for válido, o procedimento retorna um objeto Folder. Em seguida, ele verifica se o argumento lngSetAttr foi fornecido. Se assim for, ele percorre todos os arquivos na pasta, acrescentando-lhes o novo atributo a todos os arquivos existentes. Utiliza o argumento lngRemoveAttr, removendo os atributos especificados se eles existirem para os arquivos da coleção.

Finalmente, o procedimento verifica se o argumento blnRecursive foi definido como True. Se assim for, chama o procedimento para cada arquivo em cada subpasta do argumento strPath.

Tags: VBA, Tips, files, directory, folder, Scripting Runtime object library, Scrrun.dll, FileSystemObject, GetFiles, ChangeFileAttributes, 

André Luiz Bernardes

bernardess@gmail.com

VBA Tips - Retornando arquivos dentro de um diretório - Returning Files from the File System - Scripting Runtime object library - Scrrun.dll

Termo de Responsabilidade 

Como fazemos para saber quantos arquivos tem no ambiente em que estamos trabalhando?

Depois de criar uma nova instância do FileSystemObject, pode usá-lo para trabalhar com unidades, pastas e arquivos no sistema de arquivos.

O procedimento a seguir retorna os arquivos em uma pasta específica em um objeto Dictionary. O procedimento GetFiles recebe três argumentos: 

O caminho para o diretório, 

Um objeto Dictionary, e

Um argumento booleano opcional que especifica se o procedimento deve ser chamado recursivamente. 

Retornando um valor booleano que indica se o procedimento foi bem sucedido.

O primeiro procedimento usa o método GetFolder para retornar uma referência a um objeto Folder. Em seguida, percorre a coleção de arquivos da pasta e adiciona o caminho e o nome do arquivo para cada arquivo no objeto Dictionary. Se o argumento blnRecursive estiver definido como True, o procedimento é chamado recursivamente, GetFiles para retornar os arquivos em cada subpasta.

Adicione uma referência a Scripting Runtime object library no seu projeto VBA.

Ao instalar as aplicações do MS Office, uma das bibliotecas de objetos instalados no seu sistema é o Scripting Runtime object library. Esta biblioteca contém objetos úteis a partir de qualquer VBA ou script, e por isso é fornecido como uma biblioteca separada.

Os objetos na Scripting Runtime object library facilitam o acesso ao sistema de arquivos, e torna a leitura e gravação num arquivo texto muito mais simples.

Por padrão, nenhuma referência é definido para esta biblioteca, então você deve definir uma referência para que você possa usá-lo. Se o Scripting Runtime object library não aparecer na caixa de diálogo de Referências (menu Ferramentas), você deve ser capaz de encontrá-la na subpasta C:\Windows\System\Scrrun.dll.

Utilize o código abaixo:

Function GetFiles (strPath As String, dctDict As Dictionary, Optional blnRecursive As Boolean) As Boolean            

   ' Esta função retorna todos os arquivos que estiverem dentro de um diretório

   ' como um objeto Dictionary. Se efetuarmos a chamada recursivamente, este retornará

   ' todos os arquivos nas subpastas.

   

   Dim fsoSysObj      As FileSystemObject

   Dim fdrFolder      As Folder

   Dim fdrSubFolder   As Folder

   Dim filFile        As File

   

   ' Retorna um novo FileSystemObject.

   Set fsoSysObj = New FileSystemObject

   

   On Error Resume Next

   ' Obtém a pasta.

   Set fdrFolder = fsoSysObj.GetFolder(strPath)

   If Err <> 0 Then

      ' Incorrect path.

      GetFiles = False

      GoTo GetFiles_End

   End If

   On Error GoTo 0

   

   ' Efetua o Loop através da coleção de arquivos, adicionando-os ao dictionary.

   For Each filFile In fdrFolder.Files

      dctDict.Add filFile.Path, filFile.Path

   Next filFile

   ' Se o flag Recursivo for true, executa recursivamente.

   If blnRecursive Then

      For Each fdrSubFolder In fdrFolder.SubFolders

         GetFiles fdrSubFolder.Path, dctDict, True

      Next fdrSubFolder

   End If

   ' Retorna True se não ocorrer nenhum erro.

   GetFiles = True

   

GetFiles_End:

   Exit Function

End Function

Você pode usar a seguinte função para testar o procedimento GetFiles. Esta cria um novo objeto Dictionary e passa para o procedimento GetFiles.

Sub TestGetFiles()

   ' Call to test GetFiles function.

   Dim dctDict As Dictionary

   Dim varItem As Variant

   

   ' Create new dictionary.

   Set dctDict = New Dictionary

   ' Call recursively, return files into Dictionary object.

   If GetFiles(GetTempDir, dctDict, True) Then

      ' Print items in dictionary.

      For Each varItem In dctDict

         Debug.Print varItem

      Next

   End If

End Sub

Você também pode usar o objeto FileSearch, para encontrar um arquivo ou grupo de arquivos. O objeto FileSearch tem certas vantagens em que você pode pesquisar subpastas, para um determinado tipo de arquivo, ou pesquisar o conteúdo de um arquivo, basta definir algumas propriedades.

Por outro lado, a Scripting Runtime object library permite que trabalhe com arquivos individuais ou pastas como objetos que têm seus próprios métodos e propriedades. Por exemplo, o procedimento ChangeFileAttributes, altera atributos de arquivo, definindo a propriedade de atributos para cada objeto de arquivo na coleção de arquivos de um objeto de pasta particular.

Tags: VBA, Tips, files, directory, folder, Scripting Runtime object library, Scrrun.dll, FileSystemObject, GetFiles

André Luiz Bernardes

bernardess@gmail.com