Exportar archivos

5 envíos / 0 nuevos
Último envío
Omarrodriguez
Imagen de Omarrodriguez
Offline
última acción: Hace 4 meses 3 semanas
alta: 24/05/2017 - 16:58
Puntos: 145
Exportar archivos

Buen día

Tengo una macro que exportar archivos TXT y los guarda en una carpeta que esta guardada en disco local C

pero si guardo un archivo con el mismo nombre dos veces, me marca error y pues en pocas palabras todo

se sale de orden, quisiera saber si alguien me podria ayudar para resolver el problema

Anexo el codigo que estoy usando, ya que excel primero lo exporta en .PRN y despues lo conviete a TXT

De antemano gracias!

Sub generar_texto1()
Dim intUltimaFila As Long
Application.ScreenUpdating = False
 Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Workbooks.Add
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
Range("A2").Select
    nbre = InputBox("Ingrese nombre del archivo")
    ruta = "C:\Cargas Batch"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=ruta & "\" & nbre & ".prn", _
        FileFormat:=xlTextPrinter, CreateBackup:=False
    ActiveWorkbook.Close
   MsgBox ("Archivo generado exitosamente")
Application.ScreenUpdating = True

Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object
Dim Fichero As Object, tmpFichero As Object
Dim strRutaInicial As String

strRutaInicial = "C:\Cargas Batch"

Set fso = CreateObject("Scripting.FileSystemObject")
Set fCarpeta = fso.GetFolder(strRutaInicial)

For Each tmpFichero In fCarpeta.Files
Name tmpFichero.Path As Left(tmpFichero.Path, (InStrRev(tmpFichero.Path, "."))) & "txt"
Next tmpFichero

Set tmpFichero = Nothing
Set Fichero = Nothing
Set tmpCarpeta = Nothing
Set fCarpeta = Nothing
Set fso = Nothing


End Sub

Cron
Imagen de Cron
Offline
última acción: Hace 18 horas 12 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntos
alta: 23/06/2010 - 12:30
Puntos: 8840
Antes de hacer el SaveAs, yo

Antes de hacer el SaveAs, yo comprobaría si el archivo existe. Esto se puede hacer recorriendo la carpeta y comparando uno a uno los nombres de los archivos, con la función Dir. Puede ser algo así como:

Dim archivo As String
archivo = Dir("ruta" & "\*.*")

Do While Len(archivo) > 0
  If archivo = nbre then Exit Sub
  archivo = Dir

Loop

 

Yo he puesto un Exit Sub, pero tú puedes hacer lo que consideres (borrar el archivo, avisar al usuario para que cambie el nombre del archivo...)

 

Un saludo

Omarrodriguez
Imagen de Omarrodriguez
Offline
última acción: Hace 4 meses 3 semanas
alta: 24/05/2017 - 16:58
Puntos: 145
Gracias por responder y creo

Gracias por responder y creo esa es la respuesta, pero al momento de teclear el codigo

 archivo = Dir("C:\Cargas Batch" & "\*.*")
Do While Len(archivo) > 0
    If archivo = nbre Then
    MsgBox ("Ya existe un archivo con el mismo nombre"), vbCritical
    archivo = Dir
Loop

me pone "Loop sin Do"

no se si este poniendo algo mal o que me falte algo mas, ya teclee tambien lo de "Dim archivo As String

Saludos!

Cron
Imagen de Cron
Offline
última acción: Hace 18 horas 12 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntos
alta: 23/06/2010 - 12:30
Puntos: 8840
Creo que te falta un End If

Creo que te falta un End If

Omarrodriguez
Imagen de Omarrodriguez
Offline
última acción: Hace 4 meses 3 semanas
alta: 24/05/2017 - 16:58
Puntos: 145
Muchas gracias!ya pude

Muchas gracias!

ya pude resolver el problema