VBA Tips - Grave arquivo texto externo - write to external text file without quotes in VBA

|Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

DESENVOLVO APLICAÇÕES VBA

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba  3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Você tem direito as informações da sua empresa

Você já precisou gravar os dados de um linha dentro de um arquivo texto?

Sim, isso pode ser necessário vez ou outra. Como posso exportar uma única linha, gravando-a num arquivo texto em qualquer uma das minhas aplicações VBA?

Segue:

' Grava os arquivos de Script base para um Batch.

SUB Process

    Dim Script_Fase01 As Variant

    Dim nPath_01 As Variant

    Dim nPath_01b As Variant

    Let nPath_01 = Form_frm_Parameter_001.cxPath_001.Value

    Let nFile_01 = Form_frm_Parameter_001.cxFile_001.Value

    Let nFile_01b = Form_frm_Parameter_001.cxFile_001b.Value

     ' Arquivos que evocarão os scripts.

     Let Script_Fase01 = ":r " & nPath_01 & nFile_01

     Call WriteFile (nPath_01 & nFile_01b, Script_Fase01)

END SUB

Function WriteFile (nFile As Variant, nFrase As Variant)

    '        Author: André Luiz Bernardes - Bernardess@gmail.com.

    '          Date: 09/04/2013 - 10:21.

    '   Application: 

    ' Functionality: Grava uma frase em um arquivo texto externo.

    

  Dim strList As String

  

  Open nFile For Output As #1

  

  Print #1, nFrase

  

  Close #1

End Function

Tags: VBA, Tips, File, export, quotes, output, Open, print, Close, text

Outlook VBA - Imprima documentos anexados

Receba  3 Calendários Customizáveis de  2013 em Excel

Você tem direito as informações da sua empresa

MIS - Usufruindo a excelência na análise das suas Informações

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Key Performance Indicators - 7 Características desejáveis

Criei um código para imprimir todos os anexos que receber mesmo que estes cheguem compactados. O modo como escolhi fazer isso envolve salvar o arquivo zipado para um local temporário e descompactá-lo de lá.

Manipulando Impressoras e Impressões: 

• 🖨️ Imprimindo em Impressora Matricial
• 🖨️ Como Automatizar Configurações de Impressão em Relatórios
• 🖨️ Como Listar Todas as Impressoras Instaladas
• 🖨️ Como Listar Tipos de Papel e Bandejas Suportados pela Impressora
• 🖨️ Como Abrir Relatórios Filtrados de Forma Eficiente
• 🖨️ Como Gerenciar Relatórios Sem Dados Usando VBA

Mas isso não funciona tão bem, o problema é que ao salvar o arquivo zipado, recebo automaticamente um alerta do explorer perguntando se quero descompactá-lo.

Para evitar este pop-up precisei renomear o arquivo como .TXT, saldo-o assim e em seguida, após tê-lo salvo, renomeá-lo novamente para .ZIP.

Sub PrintMail()

Dim ns As NameSpace

Dim Item As Outlook.MailItem

Dim Inbox As MAPIFolder

Dim Atmt As Attachment

Dim FileName As String

Dim Done As MAPIFolder

Dim i As Integer

Dim Fname1 As String

Dim myMailBox As String

Dim currentTime As Date

Dim unzipedFile As String

Dim atmtName As String

Dim searchString As String

Dim oApp As Object

Dim FileNameFolder As Variant

Dim FSO As Object

Set ns = GetNamespace("MAPI")

Let myMailBox = "Mailbox - AD" 

Let searchString = ".zip"

Select Case ns.GetDefaultFolder(olFolderInbox).Parent

Case myMailBox

Set MyInbox = ns.Folders(myMailBox).Folders("Inbox").Items

Set PrintMailBox = ns.Folders("Mailbox - PRINT").Folders("Inbox").Items

Set Inbox = ns.Folders("Mailbox - PRINT").Folders("Inbox")

Set Done = Inbox.Folders("Printed")

Case "Mailbox - PRINT"

Set PrintMailBox = ns.Folders("Mailbox - PRINT").Folders("Inbox").Items

Set Inbox = ns.Folders("Mailbox - PRINT").Folders("Inbox")

Set Done = Inbox.Folders("Printed")

End Select

If PrintMailBox.Count > 0 Then

For Each Item In PrintMailBox

If Item.Attachments.Count > 0 Then

Item.PrintOut

For Each Atmt In Item.Attachments

If Right(Atmt.FileName, 3) = "zip" Then

'FileNameFolder = "C:\Temp\"

'FileName = FileNameFolder & Atmt.FileName

'Atmt.SaveAsFile FileName 'THIS IS WHERE THE POP UP OCCURS

'Set oApp = CreateObject("Shell.Application")

'oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((FileName)).Items 

Let FileNameFolder = "C:\Temp\"

Let FileName = FileNameFolder & Left(Atmt.FileName, (InStr(1, Atmt.FileName, ".zip") - 1)) & ".txt"

Atmt.SaveAsFile FileName 'copy the file to the folder

Let FileNameT = FileNameFolder & Atmt.FileName

Name FileName As FileNameT

Set oApp = CreateObject("Shell.Application")

oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((FileNameT)).Items

On Error Resume Next

Set FSO = CreateObject("scripting.filesystemobject")

FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True

Kill FileName

Let atmtName = Atmt.FileName

Let unzipedFile = Left(atmtName, (InStr(1, atmtName, searchString) - 1))

Select Case Right(unzipedFile, 3)

Case "doc"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-doc") - 1))

Let FileName = "C:\Temp\" & FileName & ".doc"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

Case "ocx"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-docx") - 1))

Let FileName = "C:\Temp\" & FileName & ".docx"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

Case "xls"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-xls") - 1))

Let FileName = "C:\Temp\" & FileName & ".xls"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

Case "lxs"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-xlsx") - 1))

Let FileName = "C:\Temp\" & FileName & ".xlsx"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

Case "ppt"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-ppt") - 1))

Let FileName = "C:\Temp\" & FileName & ".ppt"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

Case "pps"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-pps") - 1))

Let FileName = "C:\Temp\" & FileName & ".pps"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

Case "ptx"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-pptx") - 1))

Let FileName = "C:\Temp\" & FileName & ".pptx"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

Case "pdf"

Let FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-pdf") - 1))

Let FileName = "C:\Temp\" & FileName & ".pdf"

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

End Select

Else

Let FileName = "C:\Temp\" & Atmt.FileName

Atmt.SaveAsFile FileName

ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

End If

Next Atmt

Item.Move Done

End If

Next Item

End If

Let currentTime = Now

Do Until currentTime + TimeValue("00:00:30") <= Now

Loop

Call DeleteFiles

End Sub

👉 Não se esqueça de seguir André Bernardes no Linkedin. Clique aqui e me contate via What's App. 

Comente e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

 Série de Livros nut Project