I have a excel 2007 workbook , with current worksheet named 'a' Now what I want is,
When user clicks a button in sheet a, it should ask,
Which csv file to import,
Ask for name of that new sheet user want (where that csv file is to be placed).. Say to simplify user says 'b' now.
After that copy 'sheet a' into the new sheet b.
Import the csv into that new sheet, comma delimted, and allow overwriting of existing cells in copied sheet.
What can be basic start level code to accomplish all these tasks?
I will be grateful for any help in this regard.
Thanks
Sal
Try this:
Public strFile As String
Sub Main()
Dim WS As Worksheet
strFile = Application.GetOpenFilename("Excel workbooks,*.csv*")
If strFile = "False" Then
' the user clicked Cancel
Else
y = Right(strFile, Len(strFile) - InStrRev(strFile, "\", -1, vbTextCompare))
zz = Left(y, InStr(1, y, ".", vbTextCompare) - 1)
flag = 0
For k = 1 To Worksheets.Count
If Sheets(k).Name = zz Then
flag = 1
End If
Next
Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))
If flag = 0 Then
WS.Name = zz
Else
MsgBox ("Sheet with same name already exist. Imported to default sheet")
End If
importcsv
End If
End Sub
Sub importcsv()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strFile, Destination:=Range( _
"$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Related
Hey so i found a specific query to import a file into excel from a specific row and delete the following datga each time you open it again. but is it also pssible to stop adding rows at a specific line? and is it possible to leave some rows out if there for example is a specific word in that line?
Sub Sample()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\sample.txt", Destination:=Range("$A$1") _
)
.Name = "Sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
You can do it, but not with a Querytable.
Try this code:
Private Sub Open_Click()
Dim fn As Variant, myLine As Long, txt As String, x As Variant, ouput As String
Dim i As Integer, j As Integer: j = 1
Dim sht As Worksheet
Set sht = Worksheets("Sheet1") 'Modify Sheet Name
fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _
"Open File")
If fn = False Then Exit Sub
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
x = Split(txt, vbNewLine)
For i = 0 To UBound(x)
If x(i) <> "SomeCriteria" Then 'Check for some criteria
sht.Cells(j, 1).Value = x(i)
j = j + 1
End If
Next i
End Sub
So what it does basically, it opens a user selected txt file and stores it in the variable txt. Do seperate the rows you can use the split-function. Now each line is stored in an array x. You could go trough the array/each line and take out the ones you want. To check if a specific word is in a line, use the InStr-function.
I have yearly data files (text delimited) that will each be named "2016 latest", "2017 latest", "2018 latest", etc. I have a macro written that will bring up the file window and allow the user to chose the file and then automatically import it into the workbook. However, I want to include some error control that will reject the file and endsub if, for example, the last file uploaded was "2016 latest" and the file they try to upload is "2018 latest". I'm trying to prevent years from being duplicated or years from being skipped. How would I do this? I've attached the code I have so far.
Option Explicit
Sub ImportTextFile()
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Dim fName As String, LastRow As Long
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fName = "False" Then Exit Sub
LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
Destination:=Range("A" & LastRow))
.Name = "sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
Selection.EntireRow.Delete
End Sub
I'm trying to convert tsv files in a folder to xlsx format by importing them as text file using Data=>From Text option via VBA.
During that encountered this error
Code:
Sub convert()
Dim CSVfolder As String, XlsFolder As String, fname As String, wBook As Workbook
CSVfolder = ActiveSheet.Range("B2").Value & "\"
fname = Dir(CSVfolder & "*.tsv")
Do While fname <> ""
Workbooks.Add
Set wBook = ActiveWorkbook
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=Range("$A$1"))
.Name = fname
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
wBook.Close False
fname = Dir
Loop
End Sub
End Sub
Why i'm getting the error in .Refresh BackgroundQuery:=False ?
The error is happening there as it's at the Refresh stage that it looks for the file.
The issue is that Fname won't contain the path.
Change your connection to:
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & CSVfolder & fname, Destination....
This function is designed to open a CSV file, and import all the data into a specific Sheet on an Excel Workbook.
But I think there is some kind of problem I can't resolve in some cases with delimiters.
This is my function:
Sub LoopAllExcelFilesInFolder_Invenotry()
Dim strFilename As String
Dim wsMstr As Worksheet: Set wsMstr = ThisWorkbook.Sheets("ALL_ACTIUS")
If MsgBox("Erase sheet before start importing?", vbYesNo, "Delete?") _
= vbYes Then wsMstr.UsedRange.Clear
strFilename = Application.GetOpenFilename _
(FileFilter:="CSV File (*.csv), *.csv", _
Title:="Select CSV file: ")
Worksheets("ALL_MACHINES").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strFilename, _
Destination:=Range("A1"))
.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 = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
This is part of the source code (CSV file), containing a line that is not beeing "translted" as expected:
Here you can see how this line is translated to the Excel. The 12X5" string should'nt be there. The first column should only contain IP addresses.
I'm pretty sure It's a delimiter character issue, but I can't find the solution.
The Workbooks.Open command worked for me with that issue.
Dim wb As Workbook
strFilename = "yourfilename.csv"
Set wb = Workbooks.Open(Filename:=strFilename, local:=True)
I have a script that imports a .csv file into worksheet "Data"
After the first import all following ones appear to the right of the previous imports and not added onto the bottom (last row).
I think the issue involves this area of the script:
Destination:=ThisWorkbook.Sheets("Data").Range("$A$1"))
Sub load_csv()
Dim fStr As String
With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
Exit Sub
End If
'fStr is the file path and name of the file you selected.
fStr = .SelectedItems(1)
End With
With ThisWorkbook.Sheets("Data").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=ThisWorkbook.Sheets("Data").Range("$A$1"))
.Name = "CAPTURE"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
You need to examine the destination to see what the next unused cell is.
With ThisWorkbook.Sheets("Data")
.QueryTables.Add(Connection:= _
..., Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'lots of other stuff
End With
You can rereference the ThisWorkbook.Sheets("Data") repeatedly but using a With ... End With statement is easier.