Como importar un archivo con macro

Anibal escribió:

Hola a todos.

Como puedo hacer para importar un archivo de texto, tengo en la Hoja1
celda A1 la ubicación y el nombre del archivo Ej.: C:\Trabajo\Tipo1 el
archivo no tiene extensión y el nombre cambia, en este caso el archivo
se llama Tipo1.
Quisiera que el archivo se ubique en la Hoja1 celda D1.

Yo intente grabando una macro importando datos pero no puedo lograr que
me tome el nombre del archivo que esta en la celda A1. Este es el
código que genera.
...

Hola Anibal :-)

Suponiendo que tienes la ruta correcta ,en la celda A1 de la hoja1,
Prueba algo como esto:

'-
Sub Importar_Txt_Segun_Celda()

ruta = Sheets("Hoja1").Range("A1")

If ruta = vacia Then
MsgBox ("la celda no tiene ruta, jejejej! :))) ")
Exit Sub
Else
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& ruta, Destination _
:=Range("A6"))
.Name = filenametxt
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False

End With

End If

End Sub


'-


Nos comentas ok? :-)

Saludos
Monica

¡Un SAludo! :-)

www.fermu.com
www.zorval.es

Hola Tux

Muchas gracias por tu atención
Ya pude solucionarlo despues de probar de todo.
Esta bueno el incluir el mensaje cuando esta vacia la celda.
Me faltaría agregar cuando el archivo no existe, me puedes decir como
sería el código.

Muchas gracias por todo.

Anibal escribió:

Hola Tux

Muchas gracias por tu atención
Ya pude solucionarlo despues de probar de todo.
Esta bueno el incluir el mensaje cuando esta vacia la celda.
Me faltaría agregar cuando el archivo no existe, me puedes decir como
sería el código.

Muchas gracias por todo.

Hola Anibal :-)

Bien añade estas lineas:


'--
Else

On Error Resume Next

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" etc..


End With

If Not Err.Number = 0 Then
MsgBox " la ruta esta mal o no existe jejejejej!! :-P "
Exit Sub
End If
On Error GoTo 0

End If



End Sub

'-

Comentanos ok? :-)

Saludos
Monica


¡Un SAludo! :-)

www.fermu.com
www.zorval.es

Hola Tux

Me podrias decir donde coloco esas lineas el codigo que tengo es el
siguiente:

Private Sub CommandButton2_Click()


ruta = Sheets("Hoja1").Range("P5")


If ruta = vacia Then
MsgBox ("La celda P5 no tiene nombre del archivo")
Exit Sub

Else


Application.Goto Reference:=Sheets("Hoja1").Range("P5").Text
Selection.ClearContents ' Selection.QueryTable.Delete

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Sheets("Hoja1").Range("K4").Text,
Destination:=ActiveCell) 'Aqui nombre archivo
.Name = Sheets("Hoja1").Range("K4").Text
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

End If

End Sub

Te agradezco infinitamente.

Anibal escribió:

Hola Tux

Me podrias decir donde coloco esas lineas el codigo que tengo es el
siguiente:

Private Sub CommandButton2_Click()


ruta = Sheets("Hoja1").Range("P5")


If ruta = vacia Then
MsgBox ("La celda P5 no tiene nombre del archivo")
Exit Sub

Else
.

Hola Anibal :-)

Bien como pones el nombre del Txt en otra celda aparte quedaria asi:

Cuida que la ruta de la celda K4 acabe con \ "barra invertida " como el
ejemplo que te he puesto en el codigo de acontinuación ok? :-)


'
Private Sub CommandButton1_Click()

'K4= C:\Documents and settings\Usuario\escritorio\
'P5= Nuevo Documento Texto.txt

ruta = Sheets("Hoja1").Range("K4").Value
Nombretxt = Sheets("Hoja1").Range("P5").Value

If Nombretxt = vacia Then
MsgBox ("La celda P5 no tiene nombre del archivo")
Exit Sub

Else


Application.Goto Reference:=Sheets("Hoja1").Range("P5")
Selection.ClearContents

On Error Resume Next

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & ruta & Nombretxt, _
Destination:=ActiveCell) 'Aqui nombre archivo
.Name = ruta
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

If Not Err.Number = 0 Then
MsgBox " el archivo esta mal o no existe jejejejej!! :-P "
Exit Sub

End If

On Error GoTo 0

End If


End Sub

'

Nos comentas ok? :-)

Saludos
Monica


¡Un SAludo! :-)

www.fermu.com
www.zorval.es