Public Sub DAORecordset()
' Definição do acesso a dados.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strfile As String
Dim Strstring As String
Dim strValue As String
Dim nLine As String
Dim nSetor As Variant
Dim nCities As String
Dim preCity As String
Dim nFlag As Boolean
Let fFile = FreeFile
'Nomeia o arquivo texto que receberá os dados na pasta e arquivo definidos
Let strfile = "D:\Bernardes\TextFileName.Txt"
' Informa o nome da Query que será a base dos dados considerados.
Set db = CurrentDb
Set qdf = db.QueryDefs("qry_Lin_Export")
Set rs = qdf.OpenRecordset
' Abre o arquivo onde serão gravados os dados.
Open strfile For Output As #fFile
' Garante que o processo só rodará enquanto não for o final, nem o começo do Recordset.
If Not (rs.EOF And rs.BOF) Then
Do While Not rs.EOF
Let nLine = rs.Fields(0).Value
Let nSetor = rs.Fields(1).Value
Let nCities = ""
Let nFlag = True
Do While Not rs.EOF And (rs.Fields(1).Value = nSetor)
If nFlag Then
Let nCities = nCities & Trim(rs.Fields(2).Value) & "/"
Let preCity = Trim(rs.Fields(2).Value)
Let nFlag = False
Else
If preCity <> Trim(rs.Fields(2).Value) Then
Let nCities = nCities & Trim(rs.Fields(2).Value) & "/"
End If
End If
rs.MoveNext
Loop
' String final a ser exportada.
Let Strstring = nLine & vbTab & nSetor & vbTab & Replace(nCities, " / ", "/")
'Let strValue = Now() & " | " & nSetor & ": " & Replace(nCities, " / ", "/") 'Replace(strValue, Chr(13), "")
Debug.Print Now() & " | " & Strstring
'Exporta para tabela.
DoCmd.SetWarnings (False)
' Grava o resultado como um registro dentro de uma tabela previamente preparada.
DoCmd.RunSQL ("INSERT INTO tbl_Linhas_Brick_Sector_002_Horizontalizado ( Linha, Setor, CIDADE ) " & _
"SELECT '" & nLine & "' AS Line, " & nSetor & " AS Sector, '" & nCities & "' AS City " & _
"FROM tbl_Sys_Add")
DoCmd.SetWarnings (True)
' Grava a string resultante da consolidação.
Print #fFile, Strstring
Let Strstring = ""
Loop
rs.Close
Close #fFile
Set rs = Nothing
Set qdf = Nothing
Set db = Nothing
End If
End Sub
