How to add an incremental count (version) to a string (file) in Excel/VBA? -
i have tried lot of different things, , seems cannot work. basically, small piece of complete code.
using microsoft scripting runtime save file, using fileexists() check if file exist before saving.
working fine if remove if-statement/loop.
however, feels fileexists won´t find string, myfilepath, when run if/loop. (getdirsubparentpath function)
dim week, username string dim myfile, myfilepath string dim version integer ' current week, xx week = format(date, "ww") ' username, e.g. niclas.madsen username = environ$("username") ' initials, first letter of last , surname caps ' e.g. niclas.madsen nm username = ucase(left(username, 1) & mid(username, instr(username, ".") + 1, 1)) ' fix filename saving purpose myfile = replace(replace("supplierorganization_w", "", ""), ".", "_") _ & "" _ & week _ & " " _ & username _ & ".csv" 'supplierorganization_wxx nm myfilepath = getdirsubparentpath & myfile ' myfilepath, if exists ' add "-1" after week number, if 1 exists, add 2, etc. if len(dir(myfilepath)) <> 0 version = 0 version = version + 1 myfilepath = dir(getdirsubparentpath & "supplierorganization_w" & week & "-" & version & " " & username & ".csv") loop until len(dir(myfilepath)) < 0 end if dim tmpfile, tmpfilepath string tmpfile = getdirsubparentpath & "tmp_file.txt" dim tmpstring string 'dim fso new filesystemobject dim fso object 'scripting.filesystemobject set fso = createobject("scripting.filesystemobject") if fso.fileexists(myfilepath) = true application.screenupdating = false open myfilepath input #1 open tmpfile output #2 tmpstring = input(lof(1), 1) 'read entire file tmpstring = replace(tmpstring, (chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) _ & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) _ & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) _ & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) _ & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) _ & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) _ & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34)), "") 'eliminate double quotation , commas in first line utf-8 print #2, tmpstring 'output result close #1 close #2 fso.deletefile (myfilepath) 'delete original file fso.copyfile tmpfile, myfilepath, true 'rename temp file fso.deletefile (tmpfile) 'delete temp file application.screenupdating = true msgbox "finished processing file", vbinformation, "done!" else msgbox "cannot locate file : " & myfilepath, vbcritical, "error" end if set fso = nothing end sub ' parent sub directory path function getdirsubparentpath() getdirsubparentpath = thisworkbook.path & application.pathseparator & "csv" & application.pathseparator & "parent" & application.pathseparator end function
i manage create solution seems viable. however, code use cleaning :) gets job done.
basically, having issues loop. return file named w16-0 (which should actual w16). should add "-x" if w16 found. incremental order should w16, w16-1, w16-2, etc.
doing try locate if there w16-0 , replace w16. furthermore, seems loop give me 1 higher amount of files have. got error. if had w16-4, ask macro find , open file named w16-5, not exist.
if me clean code, thankful!
sub removecommasdoubleq() ' ' enable reference 'microsft scripting runtime' ' under vba menu option tools > references dim week, username string dim myfile, myfilepath string dim version integer dim fso object 'scripting.filesystemobject set fso = createobject("scripting.filesystemobject") ' current week, xx week = format(date, "ww") ' username, e.g. niclas.madsen username = environ$("username") ' initials, first letter of last , surname caps ' e.g. niclas.madsen nm username = ucase(left(username, 1) & mid(username, instr(username, ".") + 1, 1)) ' fix filename saving purpose myfile = replace(replace("supplierorganization_w", "", ""), ".", "_") _ & "" _ & week _ & " " _ & username _ & ".csv" 'supplierorganization_wxx nm 'myfilepath = thisworkbook.path & "\csv\parent\" & myfile myfilepath = getdirsubparentpath & myfile debug.print myfilepath debug.print "before loop" 'version = 1 while len(dir(myfilepath)) <> 0 '// if does, append _000 name '// change _000 suit requirement myfilepath = getdirsubparentpath & "supplierorganization_w" & week & "-" & version & " " & username & ".csv" '// increment counter version = version + 1 '// , go around again if myfilepath = getdirsubparentpath & "supplierorganization_w" & week & "-0" & " " & username & ".csv" myfilepath = getdirsubparentpath & "supplierorganization_w" & week & " " & username & ".csv" debug.print myfilepath debug.print "if loop" end if loop debug.print myfilepath debug.print "loop" if fso.fileexists(getdirsubparentpath & "supplierorganization_w" & week & "-" & version & " " & username & ".csv") = false myfilepath = getdirsubparentpath & "supplierorganization_w" & week & "-" & version - 2 & " " & username & ".csv" msgbox getdirsubparentpath & "supplierorganization_w" & week & "-" & version & " " & username & ".csv" end if filename = fso.getfilename(myfilepath) debug.print filename if myfilepath = getdirsubparentpath & "supplierorganization_w" & week & "-0" & " " & username & ".csv" myfilepath = getdirsubparentpath & "supplierorganization_w" & week & " " & username & ".csv" debug.print myfilepath debug.print "her should 0" end if if myfilepath = getdirsubparentpath & "supplierorganization_w" & week & "-" & " " & username & ".csv" myfilepath = getdirsubparentpath & "supplierorganization_w" & week & "-" & version & " " & username & ".csv" end if debug.print "her er vi" filename = fso.getfilename(myfilepath) debug.print filename dim tmpfile, tmpfilepath string tmpfile = getdirsubparentpath & "tmp_file.txt" dim tmpstring string debug.print "------" debug.print myfilepath if fso.fileexists(getdirsubparentpath & "supplierorganization_w" & week & "-0" & " " & username & ".csv") = true msgbox "found w-0" myfilepath = getdirsubparentpath & "supplierorganization_w" & week & " " & username & ".csv" end if debug.print "found 0?" debug.print myfilepath if fso.fileexists(myfilepath) = true application.screenupdating = false open myfilepath input #1 open tmpfile output #2 tmpstring = input(lof(1), 1) 'read entire file tmpstring = replace(tmpstring, (chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) _ & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) _ & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) _ & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) _ & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) _ & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) _ & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) & chr(34) & chr(44) & chr(34) _ & chr(34)), "") 'eliminate double quotation , commas in first line utf-8 print #2, tmpstring 'output result close #1 close #2 fso.deletefile (myfilepath) 'delete original file fso.copyfile tmpfile, myfilepath, true 'rename temp file fso.deletefile (tmpfile) 'delete temp file application.screenupdating = true msgbox "finished processing file", vbinformation, "done!" else msgbox "cannot locate file : " & myfile, vbcritical, "error" end if set fso = nothing end sub
Comments
Post a Comment