Boa tarde,
Gostaria se alguem pode me ajudar com o código abaixo. Eu achei esse código na internet que ajuda na exportacao de txt com mais de 240 colunas.
Eu queria alterar a Função "WhiteFile" de modo que ele salve o o arquivo txt automaticamento com o nome "IMPORTAR" + DATA E HORA.
A Linha que precisa ser alterada acho que é:
" SaveFileName = Application.GetSaveAsFilename(NOME, "Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")"
tentei ActiveWorkbook.SaveAs, mas não deu certo
Alguem pode me ajudar??
Obrigado
Sub Exporta_TXT()
Dim delimiter As String
Dim quotes As Integer
Dim Returned As String
lin = ActiveSheet.UsedRange.Rows.Count
col = ActiveSheet.UsedRange.Columns.Count
Range(Cells(1, 1), Cells(lin, col)).Select
delimiter = ""
quotes = vbNo
Returned = WriteFile(delimiter, quotes)
Select Case Returned
Case "Canceled"
MsgBox "Exportação cancelada."
Case "Exported"
MsgBox "Exportação feita com sucesso."
End Select
Range("a1").Select
End Sub
Function WriteFile(delimiter As String, quotes As Integer) As String
Dim CurFile As String
Dim SaveFileName
Dim CellText As String
Dim RowNum As Integer
Dim ColNum As Integer
Dim FNum As Integer
Dim TotalRows As Double
Dim TotalCols As Double
'_______________________________________________________________________________________________________________________________
Data = VBA.Format(VBA.Date, "ddmmyyyy")
hora = VBA.Format(VBA.Time, "hhmmsss")
NOME = ThisWorkbook.Path & Application.PathSeparator & "IMPORTA" & "_" & Data & hora & ".TXT"
'_______________________________________________________________________________________________________________________________
If Left(Application.OperatingSystem, 3) = "Win" Then
SaveFileName = Application.GetSaveAsFilename(NOME, "Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")
Else
SaveFileName = Application.SaveAsFilename(NOME, "TEXT", , "Text Delimited Exporter")
End If
If SaveFileName = False Then
WriteFile = "Canceled"
Exit Function
End If
FNum = FreeFile()
Open SaveFileName For Output As #FNum
TotalRows = Selection.Rows.Count
TotalCols = Selection.Columns.Count
For RowNum = 1 To TotalRows
For ColNum = 1 To TotalCols
With Selection.Cells(RowNum, ColNum)
Dim ColWidth As Integer
ColWidth = Application.RoundUp(.ColumnWidth, 0)
Select Case .HorizontalAlignment
Case xlRight
CellText = Space(Abs(ColWidth - Len(.Text))) & .Text
Case xlCenter
CellText = Space(Abs(ColWidth - Len(.Text)) / 2) & .Text & _
Space(Abs(ColWidth - Len(.Text)) / 2)
Case Else
CellText = .Text & Space(Abs(ColWidth - Len(.Text)))
End Select
End With
Select Case quotes
Case vbYes
CellText = Chr(34) & CellText & Chr(34) & delimiter
Case vbNo
CellText = CellText & delimiter
End Select
Print #FNum, CellText;
Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
+ ColNum) / (TotalRows * TotalCols), "0%") & " Completed."
Next ColNum
If RowNum <> TotalRows Then Print #FNum, ""
Next RowNum
Close #FNum
Application.StatusBar = False
WriteFile = "Exported"
End Function
Postado : 19/02/2013 2:54 pm