Sunday, 15 June 2014

VBA Excel Import -



VBA Excel Import -

i have been looking @ different solutions , code past few hours none have worked (newbie vba). receive files of our sites uses russian characters, need have these files imported existing spreadsheet under lastly used row have info uses windows cyrillic characters.

the existing spreadsheet have columns, know how need format info in order info import under existing column headings.

the info tabbed not have headings above them.

i managed find code works import places in cell a1 sheet has macro not sheet , without columns. help appreciated.

sub dothis() dim txtarr() string, long 'txtarr = browseforfile("c:\users\rjoss\desktop\svy") txtarr = split(openmultiplefiles, vbcrlf) = lbound(txtarr, 1) ubound(txtarr, 1) import_extracts txtarr(i) next end sub sub import_extracts(filename string) ' dim tmp string tmp = replace(filename, ".txt", "") tmp = mid(tmp, instrrev(tmp, "\") + 1) ' range("a50000").end(xlup).offset(1, 0).select activesheet.querytables.add(connection:= _ "text;" & filename _ , destination:=range("a50000").end(xlup).offset(1, 0)) .name = tmp .fieldnames = true .rownumbers = false .filladjacentformulas = false .preserveformatting = true .refreshonfileopen = false .refreshstyle = xlinsertdeletecells .savepassword = false .savedata = true .adjustcolumnwidth = true .refreshperiod = 0 .textfilepromptonrefresh = false .textfileplatform = 850 .textfilestartrow = 1 .textfileparsetype = xldelimited .textfiletextqualifier = xltextqualifierdoublequote .textfileconsecutivedelimiter = false .textfiletabdelimiter = true .textfilesemicolondelimiter = false .textfilecommadelimiter = false .textfilespacedelimiter = false .textfileotherdelimiter = "~" .textfilecolumndatatypes = array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .textfiletrailingminusnumbers = true .refresh backgroundquery:=false end activecell.entirerow.delete end sub 'code copied here , modified work 'http://www.tek-tips.com/faqs.cfm?fid=4114 function openmultiplefiles() string dim filter string, title string, msg string dim integer, filterindex integer dim filename variant ' file filters filter = "text files (*.txt),*.txt" ' set dialog caption title = "select file(s) open" ' select start drive & path chdrive ("c") 'chdir ("c:\files\imports") chdir ("c:\users\rjoss\desktop\svy") application ' set file name array selected files (allow multiple) filename = .getopenfilename(filter, filterindex, title, , true) ' reset start drive/path chdrive (left(.defaultfilepath, 1)) chdir (.defaultfilepath) end ' exit on cancel if not isarray(filename) msgbox "no file selected." exit function end if msg = join(filename, vbcrlf) openmultiplefiles = msg end function

this little add-in use importing csvs. maybe help you:

it starts import info @ current selected cell. can changed @ point: destination:=activecell). since csv info in same order existing excel columns don't need alter anything. import text in code example. about cyrillic charset: .textfileplatform = -535 says unicode charset used. .textfileplatform = 855 (without trailing minus) stands oem cyrillic. '=============================================== code placed in new modul ================================================================================== function importcsv() 'this function imports csv dim columnstype() variant 'declares empty zero-based array. variable must declared mypath = application.getopenfilename("csv files (*.csv), *.csv") 'asks user csv file should imported if mypath = false exit function 'if user aborts previous question, exit whole function redim columnstype(16383) 'expand array since excel 2007 , higher has 16384 columns. excel 2003 fine = 0 16383 'start loop 16383 iterations columnstype(i) = 2 'every column should treated text (=2) next 'repeat loop , count variable if activecell nil workbooks.add application.wait dateadd("s", 1, now) activeworkbook.windows(1).caption = dir(mypath) end if activeworkbook.activesheet.querytables.add(connection:="text;" & mypath, destination:=activecell) 'creates query import csv. next lines properties of .preserveformatting = true 'older cell formats preserved .refreshstyle = xloverwritecells 'existing cells should overwritten - otherwise error can occur when many columns inserted! .adjustcolumnwidth = true 'adjust width of used columns automatically .textfileplatform = -535 'import unicode charset .textfileparsetype = xldelimited 'csv has delimited 1 - 1 delimiter can true! .textfileotherdelimiter = application.international(xllistseparator) 'uses scheme setting => european union countries = ';' , = ',' .textfilecolumndatatypes = columnstype 'all columns should treted pure text .refresh backgroundquery:=false 'this neccesary sec import can done - otherwise macro can called 1 time per excel instanz end 'on line excel starts import process activeworkbook.activesheet.querytables(1).delete 'deletes query (not data) end function 'we finished

vba excel-vba

No comments:

Post a Comment