domingo, 24 de dezembro de 2017

Ler arquivo dentro de uma pasta que está dentro de um arquivo ZIP

O código não é meu, vou deixar o link aqui para futuras consultas.
Utilizei recentemente e funciona sem problemas.

;-)

Original em:

http://www.vbforums.com/showthread.php?815681-List-files-from-zip-file-(vba)


Private Sub CommandButton1_Click()
    zpath
End Sub


Sub zpath()
    Dim sh, n
    Dim PathFilename As Variant
    
    Dim FileName As String
    FileName = "temp.sql"
    
    PathFilename = Application.GetOpenFilename("ZipFile (*.zip), *.zip")
    If PathFilename = "False" Then Exit Sub
     
    TextBoxPath.Value = PathFilename
    
    Set sh = CreateObject("shell.application")
    Set n = sh.Namespace(PathFilename)
    recur sh, n
End Sub

Sub recur(sh, n)
    Dim i, subn
    For Each i In n.items
        If i.isfolder Then
            Set subn = sh.Namespace(i)
            recur sh, subn
            Else
            Debug.Print i.Path
        End If
    Next
End Sub

domingo, 17 de dezembro de 2017

Separar conteúdo de célula em linhas

Para isto, basta determinar onde está o caracter ASC(10) que é  Line Feed e depois separar em linhas conforme a quantidade de caracteres entre os Line Feeds.

Abaixo um exemplo.
Option Explicit

Sub Separa()

    Dim i               As Integer
    Dim x               As Integer
    Dim inicio          As Integer
    Dim contador        As Integer
    Dim caracteres      As Integer
    
    ReDim posicao(50) As Integer
    ReDim texto(50) As String
    
    'Determinar onde estão as quebras de linha
    For i = 1 To Len(Range("A1"))

        If Asc(Mid(Range("A1").Value, i, 1)) = 10 Then
            posicao(contador) = i
            contador = contador + 1
        End If
               
    Next
    
    'Quebrar o texto
    inicio = 1
    caracteres = posicao(0)
    
    'Primeiro
    Debug.Print Mid(Range("A1").Value, inicio, caracteres - 1)
    inicio = posicao(x)
    caracteres = posicao(x + 1) - posicao(x)


    'Segundo em diante
    caracteres = posicao(1) - posicao(0)
    For x = 1 To contador
    
        'Último texto
        If x = contador Then
            caracteres = Len(Range("A1").Value)
            texto(x) = Mid(Range("A1").Value, inicio + 1, caracteres - posicao(x) - 1)
            Debug.Print texto(x)
            Exit For
        End If
    
        texto(x + 1) = Mid(Range("A1").Value, inicio + 1, caracteres - 1)
        Debug.Print texto(x + 1)
        
        inicio = posicao(x)
            
        caracteres = posicao(x + 1) - inicio
        
    Next
 
End Sub




domingo, 3 de dezembro de 2017

Facas e canivetes podem te levar para a cadeia! - No fio da navalha Ep.23

Não tem nada a ver com o escopo deste blog, mas isto precisa ser divulgado.





Pesquisar este blog

Arquivo do blog

Quem sou eu

Minha foto
Administrador de Empresas/Técnico em Processamento de Dados. Microsoft Office User Specialist - Excel Proficient. Pós-graduado em Business Intelligence.