I've been using the below code for awhile but have noticed that it is dropping off leading 0's.
I've tried changing the code to .OpenText and get error
"Expected Function or variable".
Files that are loaded are .csv files converted to .txt before opened using a batch script.
Sub ExcelFileMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("H:\Reports\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
'This is what I have tried changing to .OpenText and get returned error "Expected Function or variable"
Set bookList = Workbooks.Open(everyObj)
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:AET" & Range("A2600").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
bookList.Close
Here is the code I got after recording the macro. Now I'm trying to figure out how to mesh the 2.
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;R:\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files\product_export1.txt" _
, Destination:=Range("$A$1"))
.CommandType = 0
.Name = "product_export1"
.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(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
OK, here's a mesh of your two, slightly adjusted:
Sub ExcelFileMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim con As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.getfolder("H:\Reports\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Add
con = "TEXT;" & everyObj
With bookList.Sheets(1).QueryTables.Add(Connection:= _
con, Destination:=Range("$A$1"))
.Name = "product_export1"
.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(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:AET" & Range("A2600").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
bookList.SaveAs "GiveItAPathAndFilenameHere"
bookList.Close
Next
End Sub
Related
I have this case when statement as subquery somewhere in a query that I need to fix and I admit I have no idea what it does, but it gives me missing right parentheses, can someone help me to fix the syntax?
(SELECT *
FROM (case when length(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 2 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 3 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 4 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 5 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 6 THEN
(SELECT
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 7 THEN
(SELECT NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 8 THEN
(SELECT NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 7, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 9 THEN
(SELECT NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 8, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 7, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 10 THEN
(SELECT SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 9, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 8, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 7, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
ELSE
(SELECT NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL)
END) NID1
You have at least 2 problems:
You cannot have a SELECT statement without a FROM clause.
You cannot have CASE WHEN ... (SELECT multiple, columns ...) as a CASE expression must return a single value.
You probably do not need the CASE expression and can use:
SELECT SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -10, 1) AS chr1,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -9, 1) AS chr2,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -8, 1) AS chr3,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -7, 1) AS chr4,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -6, 1) AS chr5,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -5, 1) AS chr6,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -4, 1) AS chr7,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -3, 1) AS chr8,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -2, 1) AS chr9,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -1, 1) AS chr10
FROM table_name
WHERE LENGTH(NATIONAL_IDENTIFIER_NUMBER) BETWEEN 2 AND 10
Which, for the sample data:
CREATE TABLE table_name (NATIONAL_IDENTIFIER_NUMBER) AS
SELECT 'a' FROM DUAL UNION ALL
SELECT 'ab' FROM DUAL UNION ALL
SELECT 'abc' FROM DUAL UNION ALL
SELECT 'abcd' FROM DUAL UNION ALL
SELECT 'abcde' FROM DUAL UNION ALL
SELECT 'abcdef' FROM DUAL UNION ALL
SELECT 'abcdefg' FROM DUAL UNION ALL
SELECT 'abcdefgh' FROM DUAL UNION ALL
SELECT 'abcdefghi' FROM DUAL UNION ALL
SELECT 'abcdefghij' FROM DUAL UNION ALL
SELECT 'abcdefghijk' FROM DUAL UNION ALL
SELECT 'abcdefghijki' FROM DUAL
Outputs:
CHR1
CHR2
CHR3
CHR4
CHR5
CHR6
CHR7
CHR8
CHR9
CHR10
null
null
null
null
null
null
null
null
a
b
null
null
null
null
null
null
null
a
b
c
null
null
null
null
null
null
a
b
c
d
null
null
null
null
null
a
b
c
d
e
null
null
null
null
a
b
c
d
e
f
null
null
null
a
b
c
d
e
f
g
null
null
a
b
c
d
e
f
g
h
null
a
b
c
d
e
f
g
h
i
a
b
c
d
e
f
g
h
i
j
fiddle
I have a Macro that loads a flat file into the current sheet. It searches a subfolder for a .dat file of the same name as the active sheet and loads in the data. I want to transition this to a vbs script that will loop through all of the sheets in the workbook and import all the data. I cannot use a macro because when the workbook is open and I try to do this, excel runs out of memory. Below is the macro:
Sub LoadData()
Dim xStrPath As String
Dim theSheet As Worksheet
Dim xFile As String
Dim xCount As Long
Dim oneCell As Range
answer = MsgBox("Are you sure you want to reload data? This will remove all existing data.", vbYesNo + vbQuestion, "Warning!")
If answer = vbYes Then
Set theSheet = Application.ActiveWorkbook.ActiveSheet
theSheet.Rows(5 & ":" & theSheet.Rows.Count).Delete
xStrPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
xFile = xStrPath & "\Old_Data\" & theSheet.Name & ".dat"
With theSheet.QueryTables.Add(Connection:="TEXT;" _
& xStrPath & "\Old_Data\" & theSheet.Name & ".dat", Destination:=theSheet.Range("A5"))
.Name = "a" & xCount
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ","
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
For Each oneColumn In theSheet.UsedRange.Columns
With oneColumn
.ColumnWidth = 40
End With
Next oneColumn
Else
'do nothing
End If
End Sub
And below is the VBScript I tried to run:
Dim xStrPath
Dim theSheet
Dim xFile
Dim xCount
Dim oneCell
Dim theFile
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Set xStrPath = WshShell.CurrentDirectory
Set theFile = GetObject(xStrPath & "\Base_Tables_Template.xlsm")
For Each theSheet In theFile
'Set theSheet = Application.ActiveWorkbook.ActiveSheet
theSheet.Rows(5 & ":" & theSheet.Rows.Count).Delete
xFile = xStrPath & "\Old_Data\" & theSheet.Name & ".dat"
With theSheet.QueryTables.Add(Connection:="TEXT;" _ & xStrPath & "\Old_Data\" & theSheet.Name & ".dat", Destination:=theSheet.Range("A5"))
.Name = "a" & xCount
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ","
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
For Each oneColumn In theSheet.UsedRange.Columns
With oneColumn
.ColumnWidth = 40
End With
Next oneColumn
Next theSheet
The VBScript is giving me an expected ')' error on line 18 char 49:
This line is
With theSheet.QueryTables.Add(Connection:="TEXT;" _ & xStrPath & "\Old_Data\" & theSheet.Name & ".dat", Destination:=theSheet.Range("A5"))
This should be behaving the same as the macro. Why would the code expect a parenthesis when the macro executes just fine?
I created UPC check-digit function in excel which is working perfectly fine but i am now in need of creating same thing in MS Access.
here is the code:
Public Function CHECKDIGIT(UPC As String) As String
If Len(UPC) = 8 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1)))
ElseIf Len(UPC) = 12 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1)))
ElseIf Len(UPC) = 13 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)) * 3, -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)) * 3)
ElseIf Len(UPC) = 14 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)))
ElseIf Len(UPC) = 17 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)) * 3, -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)) * 3)
ElseIf Len(UPC) = 18 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1), Mid(UPC, 17, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1), Mid(UPC, 17, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)))
ElseIf Len(UPC) <> 8 Or Len(UPC) <> 12 Or Len(UPC) <> 13 Or Len(UPC) <> 14 Or Len(UPC) <> 17 Or Len(UPC) <> 18 Then
CHECKDIGIT = "MISSING DIGITS"
End If
End Function
Is there any easy way to convert this to MS Access?
To my knowledge not all formulas will transfer directly to access so I image I will need to build custom function in Access too.
Any idea how to go with this?
Thanks,
Slav
The following code should work equally well in Excel and Access:
Public Function CHECKDIGIT(UPC As String) As String
Dim n As Integer
Dim i As Integer
Select Case Len(UPC)
Case 8, 12, 13, 14, 17, 18
n = 0
For i = 1 To Len(UPC) - 1
If ((Len(UPC) - i) Mod 2) = 1 Then
n = n + CInt(Mid(UPC, i, 1)) * 3
Else
n = n + CInt(Mid(UPC, i, 1))
End If
Next
CHECKDIGIT = CStr(Int(n / 10 + 0.99) * 10 - n)
Case Else
CHECKDIGIT = "MISSING DIGITS"
End Select
End Function
Thank you for the code YowE3K. I think there is something missing in that code. When i run it against results i get using my code It fails.
UPC CHCKDIGIT NEW CHKDIGIT
018371009355 5 5
00018371009355 5 5
7501206634004 4 10
00018371019354 4 14
018371019354 4 14
Also by using function i just found out that i cant use the function as part of data entry validation. I will have to use formula using what Comintern suggested above.
Thank you both guys for helping with this.
I'm trying to load a CSV or TSV into Excel, and for small files it works great; small files being < 5kb. The problem is that when I attempt to load larger files into Excel the process can take a long time. The files that I need the app to load can contain anywhere from 5 - 100 columns with anywhere from 5 to 20,000 rows.
I have tried using the BackgroundWorker, Threadpools, Parallel.For, Parallel.ForEach, but they all seem to have the same performance for this task.
The app itself is designed to take a list of headers from a separate text file, then load it into Excel, apply formatting, then loads the actual CSV/TSV file into Excel.
Here's what I have so far, this sub gets kicked off by the background worker:
Private Sub LoadTextFile(ByVal xlApp As Excel.Application, ByVal xlWb As Excel.Workbook, ByVal xlWs As Excel.Worksheet, ByVal xlRange As Excel.Range)
Dim SheetName As String = "Sheet1"
If xlWs Is Nothing Then
xlWs = DirectCast(xlWb.Sheets.Add(After:=xlWb.Sheets(xlWb.Sheets.Count), Count:=1, Type:=Excel.XlSheetType.xlWorksheet), Excel.Worksheet)
End If
'Read lines and store in a string array
Dim lines() As String = File.ReadAllLines(FileToLoad)
'Parse and write lines to Excel
For i As Integer = 0 To lines.Length - 1
'Set new row range
xlRange = xlWs.Range(startCol + (i + 2).ToString + ":" + endCol + (i + 2).ToString)
'Parse the line to load
Dim lineDetail() As String = lines(i).Split(fileDelimiter)
'Load into Excel
xlRange.Value = lineDetail
Next
End Sub
Here are some performance times:
89 Columns - 2,000 rows: Average Load Time = 7 sec.
89 Columns - 4,000 rows: Average Load Time = 12 sec.
91 Columns - 10,000 rows: Average Load Time = 28 sec.
91 Columns - 24,000 rows: Average Load Time = 70 sec.
107Columns - 8,732 rows: Average Load Time = 17 sec.
I keep thinking, "How does Excel load these files almost instantly?!?" Anyways, I will be super grateful to anyone that can help me optimize this so getting the data into Excel doesn't take so long. Thank you in advance.
This is what I came up with and I think it works very well. Thanks to TnTinMn for pointing me in the right direction :)
Dim xlApp As New Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim xlRange As Excel.Range
'Start Excel and Create Application Object
xlApp = CreateObject("Excel.Application")
'Set invisible until all loading is completed
xlApp.Visible = False
'Get/Set references of active workbook/sheet
xlWb = xlApp.Workbooks.Add
xlWb = xlApp.ActiveWorkbook
xlWs = xlWb.ActiveSheet
xlRange = xlWs.Range("$A$1")
'Used to specify the data type for each column. 2 = Text
Dim array = New Object() {2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 _
, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2}
'TextFilePlatform ANSI: 1252
With xlWs.QueryTables.Add(Connection:="TEXT;" + cfg.filePath, Destination:=xlRange)
.Name = "sec"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = Excel.XlCellInsertionMode.xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = Excel.XlTextParsingType.xlDelimited
.TextFileTextQualifier = Excel.XlTextQualifier.xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = cfg.fileTSV
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = cfg.fileCSV
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = array
.TextFileTrailingMinusNumbers = True
.Refresh(BackgroundQuery:=False)
End With
'Add headers do formatting here
'<Additional Worksheet formats here>
xlApp.Visible = True
I have a macro that uses the get external data option to import a text file. Is there a way that I can prompt the user to select a file in this code or should I take a different approach? I like this approach because I can exclude some columns during the import, but I am open to other options.
With Sheets(1).QueryTables.Add(Connection:= _
"TEXT;C:\Program Files\SubDirectory\ThisIsMyFile.txt" _
, Destination:=Range("$A$1"))
.Name = "ThisIsMyFile"
.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 = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 9, 9, 2, 9, 2, 9, 9, 9, 2, 9, 9, 9, 2, 2, 9, 2, 9, 2, 9, 2, _
9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 2, 9, 2, 9, 2, 9, 2 _
, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 9, 9, 2, 9, 9, 9, 2, 9, 2, 9, 9, 9, _
2, 9, 9, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Thanks in advance!
Thanks for the help. I got this code to work:
Dim FileFilter As String
Dim Filename As String
Dim SrcWkb As Workbook
MsgBox "Select file"
FileFilter = "Text Files (*.txt), *.txt"
Filename = Application.GetOpenFilename(FileFilter, 1)
If Filename = "False" Then Exit Sub
With Sheets(1).QueryTables.Add(Connection:= _
"TEXT;" & Filename, Destination:=Range("$A$1"))
.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 = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 9, 9, 2, 9, 2, 9, 9, 9, 2, 9, 9, 9, 2, 2, 9, 2, 9, 2, 9, 2, _
9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 2, 9, 2, 9, 2, 9, 2 _
, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 9, 9, 2, 9, 9, 9, 2, 9, 2, 9, 9, 9, _
2, 9, 9, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Something like this should work:
Sub FileName()
fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then QueryTable fileToOpen
End Sub
Sub QueryTable(file As String)
With Sheets(1).QueryTables.Add(Connection:= _
"TEXT;" & file, Destination:=Range("$A$1"))
.Name = "ThisIsMyFile"
.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 = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 9, 9, 2, 9, 2, 9, 9, 9, 2, 9, 9, 9, 2, 2, 9, 2, 9, 2, 9, 2, _
9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 2, 9, 2, 9, 2, 9, 2 _
, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 9, 9, 2, 9, 9, 9, 2, 9, 2, 9, 9, 9, _
2, 9, 9, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub