Reputation: 77
I have a TXT file
, but when I insert it in my Excel it is removing the zeros
and I don't know why it is happening and I tried to put the field type TEXT
(but it changes it back to general) and also in my macro to put xlPasteValuesAndNumberFormats
.
Sub Get_Data_FromFile()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browser for your file & Import range", FileFilter:="Text Files (*.txt), *txt*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Range("A1:U1000").Copy
ThisWorkbook.Worksheets("Asiento único").Range("E18").PasteSpecial xlPasteValuesAndNumberFormats
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub
Upvotes: 1
Views: 76
Reputation: 54807
Origin
and FielInfo
parameters.Option Explicit
Sub ImportTextFile()
Const sfRow As Long = 1
Const dName As String = "Asiento único"
Const dFirstCell As String = "E18"
Const Cols As String = "A:U"
Dim msgString As String
Dim IsSuccess As Variant
Dim dwb As Workbook: Set dwb = ThisWorkbook
Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
Dim dfCell As Range: Set dfCell = dws.Range(dFirstCell)
' Create the FieldInfo parameter (all columns as text)
Dim dcrg As Range: Set dcrg = dws.Columns(Cols)
Dim dfCol As Long: dfCol = dcrg.Columns(1).Column
Dim dlCol As Long: dlCol = dcrg.Columns(dcrg.Columns.Count).Column
Dim cArr As Variant: ReDim cArr(0 To dlCol - dfCol)
Dim c As Long
For c = dfCol To dlCol
cArr(c - dfCol) = Array(c, xlTextFormat)
Next c
Application.ScreenUpdating = False
Dim FileToOpen As Variant
FileToOpen = Application.GetOpenFilename( _
Title:="Browser for your file & Import range", _
FileFilter:="Text Files (*.txt), *txt*")
If FileToOpen <> False Then
Workbooks.OpenText _
Filename:="C:\Test\2021\70386358\Test.txt", _
Origin:=xlWindows, _
StartRow:=sfRow, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
FieldInfo:=cArr
Dim swb As Workbook: Set swb = ActiveWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets(1)
Dim srg As Range: Set srg = Intersect(sws.UsedRange, sws.Columns(Cols))
msgString = "Copied from" & vbLf & srg.Address(0, 0, , True) & vbLf
srg.Copy
dfCell.PasteSpecial xlPasteValuesAndNumberFormats
swb.Close SaveChanges:=False
dws.Activate
msgString = msgString & "to" & vbLf _
& ActiveWindow.Selection.Address(0, 0, , True)
dfCell.Select
IsSuccess = True
End If
Application.ScreenUpdating = True
If IsSuccess Then
MsgBox msgString, vbInformation
Else
MsgBox "You canceled.", vbExclamation
End If
End Sub
Upvotes: 1