Sub importa_texto_nome()
On Error GoTo erro
Dim Pasta As String
Dim Arquivo As String
Dim linha As Double
Dim registro As String
Dim vetor() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Selecione a pasta"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
Pasta = .SelectedItems(1) & "\"
End If
End With
Range("A:AA").Clear
Application.Cursor = xlWait
Application.ScreenUpdating = False
linha = 1
Arquivo = Dir(Pasta & Arquivo)
Do While Arquivo <> ""
Open Pasta & Arquivo For Input As #1
DoEvents
Do Until EOF(1)
DoEvents
Line Input #1, registro
vetor() = Split(registro, ";") 'Ajustar a quantidade de colunas de acordo com a necessidade
Cells(linha, 1) = vetor(0)
Cells(linha, 2) = vetor(1)
If linha = 1 Then
Cells(linha, 3) = "Arquivo"
Else
Cells(linha, 3) = Arquivo
End If
linha = linha + 1
Loop
Close #1
Arquivo = Dir
Loop
erro:
Application.ScreenUpdating = True
Application.Cursor = xlDefault
If Err.Number = 0 Then
MsgBox "A importação dos arquivos de texto foi concluída."
Else
MsgBox Err.Description, vbCritical
End If
Exit Sub
End Sub
sábado, 15 de julho de 2023
Importação de arquivos csv em lote - Excel VBA
quarta-feira, 26 de abril de 2023
Outlook VBA - capturar o link de uma imagem no corpo do e-mail
Deixando registrado aqui o código de uma necessidade pontual.
;-)
Sub CapturarAtributoTag()
Dim objMail As Outlook.MailItem
Set objMail = Application.ActiveExplorer.
Dim objHTMLDoc As MSHTML.HTMLDocument
Set objHTMLDoc = New MSHTML.HTMLDocument
objHTMLDoc.body.innerHTML = objMail.HTMLBody
Dim objImg As MSHTML.HTMLImg
Set objImg = objHTMLDoc.
MsgBox objImg.getAttribute("src")
End Sub
sexta-feira, 3 de março de 2023
Capturar a assinatura do Outlook pelo VBA
Naõ tenho certeza se este código ainda funciona, mas vou deixar aqui para registro antes de apagar dos meus backups.
;-)
Option Explicit
Dim assinatura As Variant
Public Function pega_assinatura(ByVal sFile As String) As String
'Dick Kusleika
Dim FSO As Object
Dim ts As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ts = FSO.GetFile(sFile).OpenAsTextStream(1, -2)
pega_assinatura = ts.ReadAll
ts.Close
End Function
Sub Cria_mensagem_HTML()
'Creates a new e-mail item and modifies its properties.
Dim olApp As Outlook.Application
Dim objMail As MailItem
Set olApp = Outlook.Application
'Create mail item
Set objMail = olApp.CreateItem(olMailItem)
assinatura = pega_assinatura("C:\Documents and Settings\" & Environ("username") & "\AppData\Roaming\Microsoft\Assinaturas\Paulo.htm")
With objMail
'Set body format to HTML
'a tag <br/> quebra linha
'a tag <strong></strong> formata o texto para negrito
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><H2>The body of this message will appear in HTML.</H2><BODY>Type the " & _
"<strong>message</strong><br/>Nova Linha</BODY><br/></HTML>" & assinatura
.Display
End With
End Sub
quarta-feira, 8 de fevereiro de 2023
Dicas para não perder código VBA
Segue aí uma dica para evitar perda de códigos VBA, que pode ocorrer se o personal.xlsb corromper ou mesmo se der problema no próprio computador.
Um dia o meu personal.xlsb corrompeu e eu perdi vários códigos porque não conseguia acessá-los mais e também não foi possível recuperar o arquivo, desde então parti para duas soluções:
1 - fazer backup do personal.xlsb periodicamente;
2 - exportar os módulos um a um em arquivos separados. Isso facilita também quando quero levar os códigos para outro computador, bastando apenas importá-los dentro do VBA.
Assinar:
Comentários (Atom)
Quem sou eu
- Kazu
- Administrador de Empresas/Técnico em Processamento de Dados. Microsoft Office User Specialist - Excel Proficient. Pós-graduado em Business Intelligence.