Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Error Macro Import TXT

Excel - Error Macro Import TXT

Volver
Nuevo Tema
<<>>
 
Vista:

Error Macro Import TXT

Publicado por Craexus92 (1 intervención) el 26/01/2021 17:11:27
Hola Compis, Os explico mi problema a ver si me podeis ayudar (No tengo mucha experiencia en VBA)

Tengo una macro que me deja seleccionar que TXT quiero importar, el problema es que SIEMPRE me trae el mismo TXT, lo eexplico mejor:

Si yo por ejemplo tengo 2 archivos TXT en el escritorio o en carpetas, por mucho que yo seleccione un TXT u otro, siempre me va a traer el TXT cuyo nombre sea alfabeticamente primero. Pongamos el ejemplo que tengo "111Alpha.txt" y "110Alpha.txt", aunque yo seleccione el primero de ellos: "111Alpha.txt", me va a traer el otro, por tener nombre alfabeticamente antes.

No controlo mucho de VBA aun, y no se encontrar el error, os adjunto la macro que de importación, a ver si lo conseguis ver.

Muchisimas gracias

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub Import()
Dim nRow As Long
Dim sExtension As String
Dim oFolder As FileDialog '// FileDialog object
Dim vSelectedItem As Variant
 
Application.ScreenUpdating = False
 
Set oFolder = Application.FileDialog(msoFileDialogOpen)
 
With oFolder
.AllowMultiSelect = True
If .Show = -1 Then
 
sExtension = Dir("*.txt")
 
For Each vSelectedItem In .SelectedItems
 
nRow = Range("A1").End(xlUp).Offset(0, 0).Row
 
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sExtension, Destination:=Range("$A$" & nRow))
.Name = sExtension
.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 = 14
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(16, 31, 27, 15, 24)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
sExtension = Dir
Next
Else
End If
End With
 
Application.ScreenUpdating = True
 
Set oFolder = Nothing
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Nolberto
Val: 84
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Error Macro Import TXT

Publicado por Nolberto (121 intervenciones) el 26/01/2021 20:39:38
1
sExtension = Dir("*.txt*")
siempre devolverá el primer nombre de archivo del directorio, entonces esa linea no es necesaria.

La solución modificar el ciclo for por este.
1
For i = 1 To .SelectedItems.Count

También se requiere usar
1
FileSystemObject
para luego poder obtener el nombre del archivo, el cual se extrae de la ruta completa que devuelve
1
.SelectedItems

El código queda así.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub Import()
    Dim nRow As Long
    Dim sExtension As String
    Dim oFolder As FileDialog '// FileDialog object
    Dim fso As Object
    Dim i As Long
    Dim fileName As String
 
    Application.ScreenUpdating = False
 
    Set oFolder = Application.FileDialog(msoFileDialogOpen)
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    With oFolder
        .AllowMultiSelect = True
        If .Show = -1 Then
            sExtension = Dir("*.txt*")
 
            For i = 1 To .SelectedItems.Count
                fileName = fso.getFileName(.SelectedItems(i))
 
                nRow = Range("A1").End(xlUp).Offset(0, 0).Row
 
                With ActiveSheet.QueryTables.Add(Connection:= _
                    "TEXT;" & fileName, Destination:=Range("$A$" & nRow))
                    .Name = fileName
                    .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 = 14
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .TextFileConsecutiveDelimiter = True
                    .TextFileTabDelimiter = True
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = False
                    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
                    .TextFileFixedColumnWidths = Array(16, 31, 27, 15, 24)
                    .TextFileDecimalSeparator = "."
                    .TextFileThousandsSeparator = ","
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
                sExtension = Dir
            Next i
            Else
        End If
    End With
 
    Application.ScreenUpdating = True
 
    Set oFolder = Nothing
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar