[Resolvido]Módulo VBA para exportar dados

Olá
Tenho uma consulta que traz Dados para imprimir códigos de barra
O layout é Código / Nome / qtde
Gostaria de gerar uma exportação que transformasse as linhas em arquivos individuais TXT
Ou seja para os 2 exemplos abaixo seriam gerados 2 arquivos contendo os dados da tabela
O nome do arquivo poderia enumerados de 1 a infinito conforme a qtde de dados da tabela
00001 camisa 10
00002 calça. 20

Bom dia;

Procure na sala de repositório por código de barras, vai encontrar alguns exemplos.

Prezado Fernando
Talvez tenha me expressado mal
Hoje já tenho uma rotina que faz os códigos de barra e já funciona.
O que preciso é exportar os dados de uma tabela para arquivos individuais
Ou seja se a tabela possuir 10 registros estes serão exportados em arquivos separados automaticamente
Ou seja vou parar de fazer isto manualmente !!

Boa Tarde,
Não sei como vas implementar a solução... mas o seguinte extracto faz o que pretendes:

Código:


Private Const Barcodedir As String = "c:\BarcodeFiles\"


Public Function RowToFile()
    On Error GoTo Err_Handler
    Dim rst As ADODB.Recordset
   
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
   
    Dim i As Integer
    Dim t As Integer
    Dim strFileName As String
    Dim strRow As String
    Dim strHeader As String

    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.LockType = adLockReadOnly

    rst.Open "Select codigo, nome, qtde  From tblYourTable", Options:=adCmdText
    t = rst.RecordCount
   
    strHeader = "Código" & VBA.vbTab & VBA.vbTab & "Nome" & VBA.vbTab & VBA.vbTab & "Qde"

    For i = 1 To t
          strFileName = Barcodedir & "BarCode_" & i & "_" & NewGuid & ".txt"
          Set oFile = fso.CreateTextFile(strFileName)
          strRow = rst("codigo") & VBA.vbTab & VBA.vbTab & rst("Nome") & VBA.vbTab & VBA.vbTab & rst("Qde")
          oFile.WriteLine strHeader
          oFile.WriteLine "======================================================================"
          oFile.WriteLine strRow
          oFile.Close
          rst.MoveNext
    Next i
 
 
   
Exit_Handler:
    rst.Close
    Set rst = Nothing
    Set fso = Nothing
    Set oFile = Nothing
    Exit Function
Err_Handler:
    VBA.MsgBox Err.Description, , "Error in function RowToFile"
    Resume Exit_Handler
End Function


[color=#33ff00]'Esta função é opcional, neste caso é para ter certeza que no vou ter nome de ficheiros duplicados[/color]
Public Function NewGuid() As String

NewGuid = VBA.Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)


End Function


Repara que estou a utilizar ADO e não DAO, pelo que, se ainda não tens uma referência para ADO deves acrecentar uma.

Obrigado Estuardo

Seu codigo funcionou dentro do que esperava. Agora tenho que fazer minhas atualizacoes de acordo com a minha base. Muito Grato!!

Um prazer meu caro.