This shows how to find the path to the desktop folder:

Sub ShowDeskTopFolder()
MsgBox CreateObject("WScript.Shell").SpecialFolders.Item( "Desktop")
End Sub


--
Jim
"Antonyo" wrote in message
...
| Here it is a simple question (I suspect the answer isn't..)
| This code keeps the document in a Dir A: as Text I need that also keeps a
| copy in Desktop
| Thank's in Advance
| Aqui es donde empiezo a imprimir el Cheque
|
| Private Sub Workbook_BeforePrint(Cancel As Boolean)
| If ActiveSheet.Name = "Cheque" Then
| If InputBox("Escriba su Clave") < "enero2012" Then
| MsgBox "Consiga una clave!!"
| Range("A8").Select
| Cancel = True
| End If
| End If
| End Sub
|
|
|
|
|
|
| Sub ImprimirCheque()
| Dim FileSaveName As String
| Dim TextExportExcel As Object
| Set TextExportExcel = ThisWorkbook
| Dim c As Object
| Dim MyRange As Object
|
| If Worksheets("Cheque").Range("R9") = "" Then
| Range("R9").Select
| MsgBox "Escriba la cantidad del cheque.", vbInformation, "MuEbLeS De
| MeXiCo"
| Exit Sub
| End If
| If Worksheets("Cheque").Range("P15") = "" Then
| Range("P15").Select
| MsgBox "Seleccione un concepto de pago.", vbInformation, "MuEbLeS De
| MeXiCo"
| Exit Sub
| End If
| Application.ScreenUpdating = False
| Answer = MsgBox _
| (" Esta el nombre o compañia y el numero de cheque correctos ? " &
| Chr(13) & Chr(13) & _
| "Si no lo es haga click en no y corrija la informacion ", vbYesNo,
| "Maderas Y Muebles de Mexico")
| If Answer = vbNo Then Exit Sub ' the macro ends if the user selects the
| CANCEL-button
| Application.GoTo Reference:="ImprimirCheque"
| Selection.PrintOut Copies:=1, Collate:=True
| Range("A1").Select
| Sheets("PolizaToDisk").Select
| ActiveSheet.Unprotect Password:="nelvita"
| GetFile:
|
| Set MyRange = ActiveCell.CurrentRegion.Rows
| mypath = "a:\" 'set path to folder here, or use
| 'mypath=Application.DefaultFilePath
| Range("B1").Select
| 'MsgBox "Text File Name := " & ActiveSheet.Name
| FileSaveName = Application.GetSaveAsFilename _
| (InitialFileName:=CStr(mypath & ActiveCell.Value), _
| filefilter:="Text Files (*.txt), *.txt")
| If Dir(FileSaveName) < "" Then
| Select Case MsgBox("File already exists! Overwrite?", vbYesNoCancel +
| vbExclamation)
| Case vbNo
| GoTo GetFile
| Case vbCancel
| Sheets("Cheque").Select
| Exit Sub
| End Select
| End If
| 'MsgBox " FileSaveName :" & FileSaveName
| ActiveSheet.Protect Password:="nelvita"
|
| WriteFile MyRange, FileSaveName
| Sheets("Cheque").Select
| ORDER# = Range("ChequeNo").Value
| Range("ChequeNo") = ORDER# + 1
| Sheets("Cheque").Select
| Range("R6").Select
| Selection.ClearContents
| ActiveCell.FormulaR1C1 = "=NOW()"
| Range("R9").Select
| Selection.ClearContents
| Range("P15").Select
| Selection.ClearContents
| Range("R9").Select
| Application.ScreenUpdating = True
| Application.StatusBar = "Espere!... Guardandoprogama y numero de cheque"
| MsgBox "Se ha guardado una copia en el archivo Mis Documentos," _
| & Chr(13) & Chr(13) & _
| "Folder PlizaToCheck Como Procedimiento de BackUp.", _
| vbInformation, "MuEbLeS De MeXiCo"
| ActiveWorkbook.Save
| Application.StatusBar = False
| Exit Sub
| Application.ScreenUpdating = True
| End Sub
| Sub WriteFile(MyRange, FileSaveName)
| Dim FF As Integer, MyLine As String
| FF = 0
| FileNum = FreeFile ' next file number
| ' open the file & add currently selected data to the file (or create it)
| Open FileSaveName For Append As #FileNum
| 'use output instead of append if you want to overwrite
| 'the entire file each time
| For Each c In MyRange 'c=rows in range
| 'assuming five columns of data to be written to file
| Print #FileNum, Cells(c.Row, c.Column).Text, _
| Cells(c.Row, c.Column + 1).Text, Cells(c.Row, c.Column + 2) _
| .Text, Cells(c.Row, c.Column + 3).Text, _
| Cells(c.Row, c.Column + 4).Text
| Next
| Close #FileNum ' close the file
| 'MsgBox MyLine, vbInformation, "Last log information:"
| End Sub
|
|
|