Bom dia!!

Faça omissão dessa linha e veja se vai parar no local em que deseja.

Observe que a segunda linha está comentada.

fileSaveName = "C:Documents and SettingsoraculoMeus documentosDownloadsTxt" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"
'fileSaveName = Pasta & "Bloco_1" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"

Deixe somente a

fileSaveName = "C:Documents and SettingsoraculoMeus documentosDownloadsTxt" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"

Att

Fazendo o sugerido, o resultado é criação de outra pasta. O que preciso é que o arquivo seja enviado e convertido para o formato txt. O que ele já faz, mas no endereço errado.

Boa tarde!!
faça o contrário

'fileSaveName = "C:UsersDesktopTxt" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"
      fileSaveName = Pasta & "Bloco_1" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"

Deixe só essa linha

fileSaveName = Pasta & "Bloco_1" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"

No meu teste gerou um arquivo Txt no Desktop
Bloco_108-12-2013.txt

Att

Tem jeito não, continua salvando em meus documentos.

Bom dia!!

Eu estou usando excel2007, não estou tendo problemas!!!

Att

Ok, o Office por cá, é o 2010, talvez seja isso. Vou dar o tópico por resolvido.
Grato

Bom dia!!

Depois eu vou testar o 2010....

Que tal você mesmo escolher o local?

Sub EscolherLocal()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wbDest As Workbook
Dim fName As String

Set wbSource = ActiveWorkbook
Set wsSource = ActiveSheet
Set wbDest = Workbooks.Add

wsSource.Range("C5:H22").Copy

wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

fName = Application.GetSaveAsFilename(FileFilter:="ext Files (*.txt), *.txt", Title:="Save As")
If fName = "" Then Exit Sub

wbDest.SaveAs fName, xlText
wbDest.Close SaveChanges:=True

End Sub

Att

Estou com Excel 2010, e do mesmo jeito que o AlexandreVBA, não estou tendo problemas.

Apenas troquei no código a referência à minha área de trabalho. Onde estava:

fileSaveName = "C:UsersDesktopTxt" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"

Troquei por:

fileSaveName = "C:UsersGilmarDesktopTxt" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"

Para testar. E funcionou

Em todo caso, vc pode pegar o endereço do desktop e inserir manualmente, veja:

Sub Salvar_Bloco()
   
   Application.ScreenUpdating = False
       Dim Pasta As String
       Dim Desktop As String
       Application.DisplayAlerts = False
       template_file = ActiveWorkbook.FullName
      
       Desktop = CreateObject("WScript.Shell").specialfolders("Desktop")
     
      'fileSaveName = Desktop & "Txt" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"
      fileSaveName = Pasta & "Bloco_1" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"
      Dim newBook As Workbook
      Dim plan As Worksheet
      Dim Intervalo As Range
       
   Set Intervalo = [C5:H22]
       
   Set newBook = Workbooks.Add
    ThisWorkbook.Activate
     Intervalo.Copy
      newBook.Sheets(1).[A1].PasteSpecial xlPasteValues
       
        For i = newBook.Sheets.Count To 2 Step -1
         newBook.Sheets(i).Delete
          Next
  ChDir (Desktop)
  newBook.SaveAs Filename:=fileSaveName, FileFormat:=xlTextWindows, CreateBackup:=False
  newBook.Close SaveChanges:=True
  Set newBook = Nothing
  Application.ScreenUpdating = True
  End Sub

Boa tarde!!

Caso ainda tenha problemas tente conforme abaixo

Sub DeskTop()
   Application.ScreenUpdating = False
       Dim Pasta As String
       Application.DisplayAlerts = False
       template_file = ActiveWorkbook.FullName
                    
        'Tente com a linha abaixo
      fileSaveName = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "Txt" + VBA.Strings.Format(Now, "dd-mm-yyyy") + ".txt"
                    
      Dim newBook As Workbook
      Dim plan As Worksheet
      Dim Intervalo As Range
       
   Set Intervalo = [C5:H22]
       
   Set newBook = Workbooks.Add
    ThisWorkbook.Activate
     Intervalo.Copy
      newBook.Sheets(1).[A1].PasteSpecial xlPasteValues
       
        For i = newBook.Sheets.Count To 2 Step -1
         newBook.Sheets(i).Delete
          Next
  newBook.SaveAs Filename:=fileSaveName, FileFormat:=xlTextWindows, CreateBackup:=False
  newBook.Close SaveChanges:=True
  Set newBook = Nothing
  Application.ScreenUpdating = True
  End Sub

As duas sugestões se não resolvem por completo o problema, ao menos o arquivo chega no desktop, e é o suficiente. Valeu alexandrevba e gtsalikis.

Boa tarde!!

Testou minha ultima sugestão, creio que possar ser melhor do que minha penúltima sugestão.

Att