Notifications
Clear all

Salvar como automaticamente

4 Posts
2 Usuários
0 Reactions
1,088 Visualizações
(@celsoyano)
Posts: 75
Trusted Member
Topic starter
 

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
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!
Mude a linha

NOME = ThisWorkbook.Path & Application.PathSeparator & "ale" & "_" & AleVBAdata & "_" & hora & ".TXT"

, nela tem o nome do arquivo como "ale" altere conforme desejado.
Tente

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")
    AleVBAdata = VBA.Format(VBA.Date, "dd/mm/yyyy")
    hora = VBA.Format(VBA.Time, "hh:mm")
    NOME = ThisWorkbook.Path & Application.PathSeparator & "ale" & "_" & AleVBAdata & "_" & 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

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 19/02/2013 4:27 pm
(@celsoyano)
Posts: 75
Trusted Member
Topic starter
 

Alexandre eu coloquei o código, ele até sugeriu o nome, mas ainda abre a caixa de dialogo.

O q eu gostaria é que ele gravasse sem abrir a caixa de dialogo conforme o nome sugerido.

 
Postado : 20/02/2013 6:09 am
(@celsoyano)
Posts: 75
Trusted Member
Topic starter
 

affff eu não acredito q era tão simples a solucao rsss

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

mudei para:

SaveFileName = NOME

obrigado

 
Postado : 21/02/2013 6:51 am