Salvar como automaticamente VBA

[celsoyano]

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

Versão: Office 2010

Arquivo: http://www.sendspace.com/file/gth2wb

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

[zinhovba]

Bom dia!!

Postagem cruzada em:

http://planilhando.com.br/forum/viewtopic.php?f=10&t=7146

[celsoyano]

Solução:

alterei a linha:

SaveFileName = Application.GetSaveAsFilename(NOME, "Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")

por

SaveFileName = NOME

[Patropi]

Caso o autor do tópico necessite, o mesmo será reaberto, para isso deverá entrar em contato com a moderação solicitando o desbloqueio.