I would like to be able to say things like
cd [.fred] and have my default directory go there,
and my prompt change to indicate the full path to my current location.
Just type
cd:==set default
at the command prompt. You can also put this in your LOGIN.COM file, but be sure to put a $ in front, i.e.
$ cd:==set default
To change your prompt to show your default, something like this may work up to a point
$ set prompt='f$env("default")'
There is a problem though with the fact that VMS prompt has maximum 32 characters, and your default might be longer than that. Have a look at this page for a way around that problem.
My DCL is really rusty, but can't you create an alias for SET DEFAULT named CD?
Here's my setup:
You need 2 files (typed below) : godir.com and prompt.com in your sys$login
You may define a symbole
CD == "#sys$login:godir.com"
But I suggest you to use something else... (ie SD == "#sys$login:godir.com")
I modify the help text. It was in french...
You will have to retype the escape caracters into godir.com
Replace ESC by the real escape into GRAPH_BOUCLE: (see bottom of godir.com)
Then to use it:
SD ?
SD a_directory
...
Hope it helps.
Here's prompt.com
$ noeud = f$trnlnm("SYS$NODE") - "::"
$ if noeud .eqs. "HQSVYC" then noeud = "¥"
$!
$ noeud = noeud - "MQO"
$ def_dir = f$directory()
$ def_dir = f$extract(1,f$length(def_dir)-2,def_dir)
$boucle:
$ i = f$locate(".",def_dir)
$ if i .eq. f$length(def_dir) then goto fin_boucle
$ def_dir = f$extract(i+1,f$length(def_dir)-1,def_dir)
$ goto boucle
$!
$fin_boucle:
$! temp = "''noeud' ''def_dir' " + "''car_prompt'"
$ temp = "''noeud'" -
+ " ''def_dir' " -
+ "''f$logical(""environnement"")'" -
+ "''car_prompt'"
$! temp = "''noeud'" -
$! + "''def_dir'" -
$! + "''f$logical(""environnement"")'" -
$! + "''car_prompt'"
$ set prompt="''temp' "
$!
$! PROMPT.COM
$!
Here's godir.com
$!
$! GODIR.COM
$!
$ set noon
$ set_prompt = "#sys$login:prompt.com"
$ if f$type(TAB_DIR_N) .nes. "" then goto 10$
$ goto 20$
$ INIT:
$ temp2 = "INIT"
$ CLEAR:
$ temp = 0
$
$ INIT2:
$ temp = temp +1
$ if temp .gt. TAB_DIR_N then goto INIT3
$ delete/symb/glo TAB_DIR_'temp'
$ goto INIT2
$
$ INIT3:
$ P1 = ""
$ if temp2 .eqs. "INIT" then goto 20$
$ delete/symb/glo TAB_DIR_N
$ delete/symb/glo TAB_DIR_P
$ delete/symb/glo TAB_DIR_I
$ exit
$
$ 20$:
$ TAB_DIR_N == 1
$ TAB_DIR_P == 1
$ TAB_DIR_I == 1
$ if "''car_prompt'" .eqs. "" then car_prompt == ">"
$ TAB_DIR_1 == f$parse(f$dir(),,,"device")+f$dir()
$ 10$:
$ if P1 .eqs. "" then goto LIST
$ if P1 .eqs. "?" then goto SHOW
$ if P1 .eqs. "." then P1 = "[]"
$ if P1 .eqs. "^" then goto SET_CUR
$ if (P1 .eqs. "<") .or. (P1 .eqs. ">") .or. -
(P1 .eqs. "..") then P1 = "[-]"
$ if (P1 .eqs. "*") .or. (P1 .eqs. "0") then goto HOME
$ if (P1 .eqs. "P") .or. (P1 .eqs. "p") then goto PREVIOUS
$ if (P1 .eqs. "H") .or. (P1 .eqs. "h") then goto HELP
$ if (P1 .eqs. "S") .or. (P1 .eqs. "s") then goto SET_PROMPT
$ if (P1 .eqs. "G") .or. (P1 .eqs. "g") then goto SET_PROMPT_GRAPHIC
$ temp2 = ""
$ if (P1 .eqs. "~INIT") .or. (P1 .eqs. "~init") then goto INIT
$ if (P1 .eqs. "~CLEAR") .or. (P1 .eqs. "~clear") then goto CLEAR
$
$! *** Specification par un numero
$ temp = f$extract(0,1,P1)
$ if temp .eqs. "-" then goto DELETE
$ temp2 = ""
$boucle_reculer:
$ if temp .nes. "\" then goto fin_reculer
$ temp2 = temp2 + "-."
$ P1 = P1 - "\"
$ temp = f$extract(0,1,P1)
$ goto boucle_reculer
$!
$fin_reculer:
$ P1 = temp2 + P1
$ if (P1 .lts. "0") .or. (P1 .gts. "9") then goto SPEC
$ temp = f$integer("''P1'")
$ if temp .eq. 0 then goto HOME
$ if (temp .lt. 1) .or. (temp .gt. TAB_DIR_N) then goto ERR
$ TAB_DIR_P == TAB_DIR_I
$ TAB_DIR_I == temp
$ goto SET2
$
$ SPEC:
$! *** Specification relative de directory
$
$ temp = f$parse("[.''P1']","missing.mis")
$ DD = f$extract(0,f$locate("]",temp)+1,temp)
$ if DD .nes. "" then goto SET1
$
$! *** Specification de directory principal
$
$ temp = f$parse("[''P1']","missing.mis")
$ DD = f$extract(0,f$locate("]",temp)+1,temp)
$ if DD .nes. "" then goto SET1
$
$ temp = f$parse("[''P1']","sys$login:missing.mis")
$ DD = f$extract(0,f$locate("]",temp)+1,temp)
$ if DD .nes. "" then goto SET1
$
$! *** Specification exacte de directory
$
$ temp = f$parse(P1,"missing.mis")
$ if f$locate("]"+P1,temp) .ne. f$length(temp) then goto ERR
$ if f$locate(".][",temp) .ne. f$length(temp) then temp = temp - "]["
$ DD = f$extract(0,f$locate("]",temp)+1,temp)
$! if DD .eqs. TAB_DIR_'TAB_DIR_I' then goto SHOW
$ if DD .eqs. TAB_DIR_'TAB_DIR_I' then goto SET2
$ if DD .nes. "" then goto SET1
$
$ temp = f$parse(P1,"sys$login:missing.mis")
$ if f$locate("]"+P1,temp) .ne. f$length(temp) then goto ERR
$ if f$locate(".][",temp) .ne. f$length(temp) then temp = temp - "]["
$ DD = f$extract(0,f$locate("]",temp)+1,temp)
$! if DD .eqs. TAB_DIR_'TAB_DIR_I' then goto SHOW
$ if DD .eqs. TAB_DIR_'TAB_DIR_I' then goto SET2
$ if DD .nes. "" then goto SET1
$
$ goto ERR
$
$ HOME:
$ DD = "SYS$LOGIN"
$
$ SET1:
$ Set On
$ On error then goto ERR1
$ set message/nofac/noid/nosever/notext
$ Set def 'DD'
$ dir/output=nl:
$ set message/fac/id/sever/text
$ temp = f$parse(f$dir()) - ".;"
$ if temp .nes. "" then goto SET1F
$ ERR1:
$ set message/fac/id/sever/text
$ temp = TAB_DIR_'TAB_DIR_I'
$ Set def 'temp'
$ goto ERR
$ SET1F:
$ I = 0
$ LOOP1:
$ I = I + 1
$ if temp .eqs. TAB_DIR_'I' then goto FOUND
$ if I .lt. TAB_DIR_N then goto LOOP1
$
$ TAB_DIR_N == TAB_DIR_N + 1
$ TAB_DIR_P == TAB_DIR_I
$ TAB_DIR_I == TAB_DIR_N
$ TAB_DIR_'TAB_DIR_I' == temp
$ goto SHOW
$
$ FOUND:
$ TAB_DIR_P == TAB_DIR_I
$ TAB_DIR_I == I
$ goto SET2
$
$ SET_PROMPT:
$ car_prompt == "''P2'"
$ set_prompt
$ exit
$
$ PREVIOUS:
$ temp = TAB_DIR_P
$ TAB_DIR_P == TAB_DIR_I
$ TAB_DIR_I == temp
$
$ SET_CUR:
$ SET2:
$ DD = TAB_DIR_'TAB_DIR_I'
$ set def 'DD'
$
$ SHOW:
$ temp = TAB_DIR_'TAB_DIR_I'
$ ws " ''TAB_DIR_I' * ''temp'"
$ set_prompt
$ exit
$
$ LIST:
$ I = 0
$ LOOP2:
$ I = I + 1
$ temp = TAB_DIR_'I'
$ if I .eq. TAB_DIR_I then goto L_CUR
$ if I .eq. TAB_DIR_P then GOTO L_PRE
$ ws " ''I' = ''temp'"
$ goto F_LOOP2
$ L_CUR:
$ ws " ''I' * ''temp'"
$ goto F_LOOP2
$ L_PRE:
$ ws " ''I' + ''temp'"
$
$ F_LOOP2:
$ if I .lt. TAB_DIR_N then goto LOOP2
$ set_prompt
$
$ exit
$
$ DELETE:
$ P1 = P1 - "-"
$ temp2 = f$integer("''P1'")
$ DEL_1:
$ temp = f$integer("''P1'")
$ if (temp .lt. 1) .or. (temp .gt. TAB_DIR_N) then goto ERR
$ if temp .eq. TAB_DIR_I then goto ERR
$ if temp .lt. TAB_DIR_I then TAB_DIR_I == TAB_DIR_I - 1
$ if temp .eq. TAB_DIR_P then TAB_DIR_P == TAB_DIR_I
$ if temp .lt. TAB_DIR_P then TAB_DIR_P == TAB_DIR_P - 1
$ LOOP3:
$ if temp .eq. TAB_DIR_N then goto F_LOOP3
$ temp3 = temp + 1
$ TAB_DIR_'temp' == TAB_DIR_'temp3'
$ temp = temp + 1
$ goto LOOP3
$ F_LOOP3:
$ delete/symb/glo tab_dir_'tab_dir_n'
$ TAB_DIR_N == TAB_DIR_N - 1
$ if P2 .eqs. "" then goto FIN_DEL
$ temp2 = temp2 + 1
$ if temp2 .le. f$integer("''P2'") then goto DEL_1
$ FIN_DEL:
$ goto LIST
$
$ ERR:
$ ws "*** ERREUR ***"
$ exit
$
$ HELP:
$ ws " H Show this menu"
$ ws " null Show a list of directories"
$ ws " ? Show current directory"
$ ws " < or [-] or"
$ ws " > or .. Remonte d'un niveau de directory"
$ ws " * ou 0 Return to SYS$LOGIN"
$ ws " P Last directory "
$ ws " . ou [] Set cureent directory"
$ ws " ^ Return to next directory"
$ ws " x Set def to number x"
$ ws " -x Remove the number x"
$ ws " -x y Remove from x to y"
$ ws " ddd Set def to [ddd] or [.ddd] or ddd:"
$ ws " \ddd Set def to [-.ddd]"
$ ws " S "">>"" Modify prompt for >>"
$ ws " ~INIT Initialize to current directory "
$ ws " (and delete all others references)"
$ ws " ~CLEAR Remove all references
$ ws ""
$
$ exit
$
$ SET_PROMPT_GRAPHIC:
$ temp = "''P2'"
$ i=0
$ car_prompt == ""
$ GRAPH_BOUCLE:
$ t=f$extract(i,1,temp)
$ if (t .eqs. "e") .or. (t .eqs. "E") then t="ESC"
$ if (t .eqs. "g") .or. (t .eqs. "G") then t="ESC(0"
$ V° (} .L-_. "N") .-_. (} .L-_. "H") }NL+ }="ESC(B"
$ car_prompt == car_prompt + t
$ i = i+1
$ if i .lts. f$length(temp) then goto GRAPH_BOUCLE
$
$ set_prompt
$ exit
Use HGSD which implements an SD (short for SET DEFAULT) command. Just google it. It is an improved version by Hunter Goatley of an older implementation.
The only thing it cannot handle (yet), are logicals with multiple translations. Other than that, It works like a charm, and you do not need to type in complete directory names. You can even move to the next directory on the same level.
It can also set the prompt if you have the right privileges in one go, so your prompt will reflect your default directory, just like in the old days on DOS.
Related
I trying to write much larger code to email a list of files in a TAR file and then send it in an email but the last thing i am struggling with is the actual listing of the contents of the TAR file. the code I have tried so far is:
Public r As Long
Sub Test()
Dim strPath As String
Dim sh, n, x, i
'Change Path To Suit
'strPath = ThisWorkbook.Path & "\"
strPath = "H:\99 - Temp\"
Set sh = CreateObject("Shell.Application")
x = GetFiles(strPath, "*.TAR", True)
r = 7
For Each i In x
Set n = sh.NameSpace(i) <----------
Recur sh, n
Next i
End Sub
Sub Recur(sh, n)
Dim i, subn, x As Long, p As Long
For Each i In n.Items
If i.isfolder Then
Set subn = sh.NameSpace(i)
Recur sh, subn
Else
p = LastPos(i.Path, "\")
Debug.Print Mid(i.Path, p + 1)
'Cells(r, 1) = Mid(i.Path, p + 1)
r = r + 1
End If
Next i
End Sub
Function GetFiles(StartPath As String, FileType As String, SubFolders As Boolean) As Variant
StartPath = StartPath & IIf(Right(StartPath, 1) = "\", vbNullString, "\")
GetFiles = Split(Join(Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & StartPath &
FileType & """ " & IIf(SubFolders, "/S", vbNullString) & " /B /A:-D").StdOut.ReadAll, vbCrLf), ":"),
"#"), "#")
End Function
Function LastPos(strVal As String, strChar As String) As Long
LastPos = InStrRev(strVal, strChar)
End Function
But I can a runtime error '-2147467259 (80004005)':
Method 'NameSpace of Object 'IShellDispatch6' failed
so I tried this one:
Sub test99()
Dim n As Variant
Set sh = CreateObject("shell.application")
Set n = sh.NameSpace("H:\99 - Temp\test.TAR")
For Each i In n.Items <-------------
Debug.Print i.Path
Next
End Sub
which returns another run-time error 91:
Object variable or with block variable not set.
I am comfortable with VBA but really struggling to integrate shell.
ideally the end goal is to get the file open window, select the TAR file that I need read (it's not always in the same folder so need it flexible) and then list the files in the TAR.
Thank you
Using ShellRun concept from here: Capture output value from a shell command in VBA?
Working on Win10
Sub tester()
Dim p, s, col, e
p = "C:\Blah\Temp\Temp.tar"
Set col = ShellOutput("tar -tf """ & p & """")
Debug.Print col.Count; " entries returned"
Debug.Print "--------------------"
For Each e In col
Debug.Print e
Next e
End Sub
'Run a shell command, returning the output as a collection of lines
Public Function ShellOutput(sCmd As String) As Collection
Dim sLine, col As Collection
Set col = New Collection
With CreateObject("WScript.Shell").Exec(sCmd).StdOut
While Not .AtEndOfStream
sLine = .ReadLine
If sLine <> "" Then col.Add sLine
Wend
End With
Set ShellOutput = col
End Function
This continues on from a previous question I have asked actually. I am desperate to find a way to remove the trailing blank lines from text files when generated from an excel file to which I have been unsuccessful so far. I have found the below code just now and when I execute it, I can see that it has the basis for what I want (I think) but I don't have the skill to amend it so that ignores any line with data in it and just deletes the blank spaces. Can anyone help me amend this so that it can delete those pesky white spaces please?
Sub AltText()
Dim File As String
Dim VecFile() As String, Aux As String
Dim i As Long, j As Long
Dim SizeNewFile As Long
File = Application.GetOpenFilename
'Import file lines to array excluding first 3 lines and
'lines starting with "-"
Open File For Input As 1
i = 0
j = 0
Do Until EOF(1)
j = j + 1
Line Input #1, Aux
If j > 3 And InStr(1, Aux, "-") <> 1 Then
i = i + 1
ReDim Preserve VecFile(1 To i)
VecFile(i) = Aux
End If
Loop
Close #1
SizeNewFile = i
'Write array to file
Open File For Output As 1
For i = 1 To SizeNewFile
Print #1, VecFile(i)
Next i
Close #1
MsgBox "File alteration completed!"
End Sub
To remove lines that are blank, try the following code:
Sub AltText()
Dim inFile As String
Dim outFile As String
Dim data As String
inFile = Application.GetOpenFilename
Open inFile For Input As #1
outFile = inFile & ".alt"
Open outFile For Output As #2
Do Until EOF(1)
Line Input #1, data
If Trim(data) <> "" Then
Print #2, data
End If
Loop
Close #1
Close #2
Kill inFile
Name outFile As inFile
MsgBox "File alteration completed!"
End Sub
you need to look for blank spaces and carriage return characters, so after you read the line, check for content:
dim temp as string
temp = Replace (aux, chr(10), "")
temp = Replace (temp,chr(13),"")
temp = Rtrim(Ltrim(temp)) ' remove just blank stuff
now check for the length:
if j > 3 and Len(temp) <> 0 then
......
add the lines
so your code should look like this:
Sub AltText()
Dim File As String
Dim VecFile() As String, Aux As String
Dim i As Long, j As Long
Dim SizeNewFile As Long
File = Application.GetOpenFilename
'Import file lines to array excluding first 3 lines and
'lines starting with "-"
Open File For Input As 1
i = 0
j = 0
Do Until EOF(1)
j = j + 1
Line Input #1, Aux
'=====
dim temp as string
temp = Replace (aux, chr(10), "")
temp = Replace (temp,chr(13),"")
temp = Rtrim(Ltrim(temp)) ' remove just blank stuff
'======
If j > 3 And Len(temp) <> 0 Then
i = i + 1
ReDim Preserve VecFile(1 To i)
VecFile(i) = Aux
End If
Loop
Close #1
SizeNewFile = i
'Write array to file
Open File For Output As 1
For i = 1 To SizeNewFile
Print #1, VecFile(i)
Next i
Close #1
MsgBox "File alteration completed!"
End Sub
I'm new to VBA, I'm pulling a few macros together. It need to find a file based on a given Path (stored in C2) and a Keyword (stored in D2) and than print the complete path into E2 , if this file is not found, prompt a dialog so the user can find it (in case a spell mistake is made for example).
What I have so far:
Public Sub Pather()
'Find path to File1 based on KeyWord1
Dim File1 As Variant, KeyWord1 As String, Path1 As String
KeyWord1 = Sheet5.Range("d2").Text
Path1 = Sheet5.Range("c2").Text
File1 = Dir(MainPath & Path1)
While (File1 <> "")
'insert keyword below
If Sheet5.Range("E2") = "" Then
'Print File1 path into E2
Sheet5.Range("E2") = Path1 & File1
' Display Error message for test reason
' (change to Dialog Script so user can find File1 )
Else:
MsgBox "File not found."
'*** add FileDialog here ***
Exit Sub
End If
File1 = Dir
Wend
End Sub
Works if I leave Else out... but when I include Else, if the file exists, it return both the File path into E2 and display the alert. What am I doing wrong?
Also, I want it to display the alert and than run the following script:
Dim fd As FileDialog
Dim FileName As String
Set fd = Application.FileDialog(msoFileDialogOpen)
'the number of the button chosen
Dim FileChosen As Integer
FileChosen = fd.Show
fd.Title = "Choose workbook"
fd.InitialFileName = "C:\test"
fd.InitialView = msoFileDialogViewList
'show Excel workbooks and macro workbooks
fd.Filters.Clear
fd.Filters.Add "Excel workbooks", "*.xlsx"
fd.Filters.Add "Excel macros", "*.xlsm"
fd.FilterIndex = 1
fd.ButtonName = "Choose this file"
If FileChosen <> -1 Then
'didn't choose anything (clicked on CANCEL)
MsgBox "No file choosen. File wont be saved as .PDF"
Else
'get file, and open it (NAME property
'includes path, which we need)
FileName = fd.SelectedItems(1)
Workbooks.Open (FileName)
End If
Is it possible to embed this 2nd script into the 1st?
Thanks soooo much
What is your input for Path1 in cell C2?
If it's a folder then the While loop goes on while there are any files to go through. That's why you get multiple outputs (i.e. return of both possible outcomes).
Also what is the purpose of KeyWord1? Is it supposed to be a wildcard, extension, or file name?
EDIT:
for listing all files that match the wildcard use:
Public Sub Pather()
'Find path to File1 based on KeyWord1
Dim File1 As Variant, KeyWord1 As String, Path1 As String
KeyWord1 = Sheet5.Range("d2").Text
Path1 = Sheet5.Range("c2").Text
File1 = Dir(MainPath & Path1)
Dim i As Integer
i = 1
While (File1 <> "")
'insert keyword below
Debug.Print File1
If Cells(i, 5) = "" Then
If InStr(File1, KeyWord1) > 0 Then
'Print File1 path into E2
Cells(i, 5) = Path1 & File1
' Display Error message for test reason
' (change to Dialog Script so user can find File1 )
i = i + 1
'Exit Sub
End If
Else
Debug.Print "File not found"
MsgBox "File not found."
'*** add FileDialog here ***
Exit Sub
End If
File1 = Dir
Wend
End Sub
If you want to list only first that matches the wildcard, remove the ' symbol from: 'Exit Sub (so it exits after the first match is found).
I have set of 500 csv files. Each file has four columns and variable number of rows.
I want to merge all of these csv's into one common sheet. If someone can help me in doing this in PowerShell, it would be great.
Sample Data in Excel 1:
Name Age Marks Class
A 15 100 5
B 20 88 6
Sample Data in Excel 2:
Name Age Marks Class
C 11 99 2
Output :
Name Age Marks Class
A 15 100 5
B 20 88 6
C 11 99 2
If all the CSV files are in one folder then:
$res = #()
ls *.csv | %{
$temp = Import-CSV $_
$res += $temp
}
$res | Export-CSV .\ALLINFO.csv -NoTypeInformation
The break down:
$res = #() - Make an array called $res that will hold all the data. This isn't strictly required. You could do it in a way that appends to a result file directly.
ls *.csv | - Find all the CSV files in the folder and pass them to the next command.
%{$temp = Import-CSV $_; $res += $temp} - Take each of those files, import the CSV data into a holder variable called $temp. Add the contents of $temp to the collector variable $res. Again it is not necessary to use the intermediate $tamp variable, I just find it more clear to do so.
$res | Export-CSV .\ALLINFO.csv -NoTypeInformation - Now that the data from all the files is in $res, export $res to a new file.
If the files are large then you could merge them as text documents. This is a lot faster than importing csv-objects, but it requires that the properties and the order in which they're placed are equal in all files. Example:
$files = Get-ChildItem "*.csv"
#Get header
$text = #(Get-Content -Path $files[0].FullName -TotalCount 1)
$files | ForEach-Object {
#Get text but skip header
$text += Get-Content -Path $_.FullName | Select-Object -Skip 1
}
#Save merged csv
$text | Set-Content Output.csv
Output.csv
Name;Age;Marks;Class
A;15;100;5
B;20;88;6
C;11;99;2
You could optimize it even more by replacing Get-Content for [System.IO.File]::ReadAllLines() etc. but I skipped that now as it's more complicated/hard to read.
UPDATE: Added alternative solution that saves the output-file part for part as Ansgar suggested.
$outputfile = "Output.csv"
$files = Get-ChildItem "*.csv"
#Get header
Get-Content -Path $files[0].FullName -TotalCount 1 | Set-Content -Path $outputfile
$files | ForEach-Object {
#Get text but skip header
Get-Content -Path $_.FullName | Select-Object -Skip 1
} | Add-Content -Path $outputfile
In your case, the sort name is optional depending on whether the merge should also reorder the contents (obviously, you can sort on a different parameter as well). Same stipulation as above - all .csv files in one directory.
dir c:\directory_containing_your\*.csv | Import-Csv | sort name | Export-Csv -Path c:\output.csv -NoTypeInformation
From the ScriptingGuy.
Here's a heavily-commented solution that uses VBA in Excel to combine the CSVs. The strategy here is this:
Set your references up-front, most importantly the strDir variable (which is a string representing the directory that holds all your CSVs)
Loop through the directory
Open each CSV
Copy the appropriate contents from each CSV
Paste the contents to the output workbook
Repeat the loop until all files have been iterated over
Hope this helps!
Option Explicit
Public Sub CombineCSVsInFolder()
Dim strFile As String, strDir As String
Dim wbkSource As Workbook, wbkOutput As Workbook
Dim wksSource As Worksheet, wksOutput As Worksheet
Dim lngLastRowSource As Long, lngLastRowOutput As Long
Dim rngSource As Range, rngOutput As Range
Dim blnFirst As Boolean
'Set references up-front
strDir = "c:\stack\my_csvs\" '<~ edit this line with the CSV directory
strFile = Dir(strDir)
blnFirst = True
Set wbkOutput = Workbooks.Add
Set wksOutput = wbkOutput.ActiveSheet
Application.ScreenUpdating = False
'Loop through the CSV directory
While (strFile <> "")
'Assign source CSV files
Set wbkSource = Workbooks.Open(strDir & strFile)
Set wksSource = wbkSource.ActiveSheet
'Assign boundaries of area to copy and output
lngLastRowSource = LastRowNum(wksSource)
lngLastRowOutput = LastRowNum(wksOutput)
With wksOutput
Set rngOutput = .Cells(lngLastRowOutput + 1, 1)
End With
'If this is the first time through, include headers, otherwise do not
If blnFirst = False Then
With wksSource
Set rngSource = .Range(.Cells(2, 1), .Cells(lngLastRowSource, 4))
End With
'Special case for first iteration to correct source and output ranges
Else
With wksSource
Set rngSource = .Range(.Cells(1, 1), .Cells(lngLastRowSource, 4))
End With
With wksOutput
Set rngOutput = .Cells(1, 1)
End With
blnFirst = False
End If
'Execute copy, close source and repeat
rngSource.Copy rngOutput
wbkSource.Close
strFile = Dir
Wend
'Turn screen updates back on
Application.ScreenUpdating = True
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Sheet, the worksheet we'll search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastRowNum(Sheet As Worksheet) As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
LastRowNum = Sheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Else
LastRowNum = 1
End If
End Function
I am new at vbs and am getting a error at the line set arr = readfile( FileName )
I am trying to read an file into an array
and can not figure out what i am doing wrong
Thanks in advance for your assistance
Dim FileName ' File Name to Process
Call MainProcedure
WScript.Quit
Sub MainProcedure
filename = "c:\print\check.bat"
WScript.Echo( "Printing document in progress..." )
WScript.Echo( "Filename ====> " & FileName )
Dim arr, i
i = 0
set arr = readfile( FileName )
For Each present In arr
' user = split(present,",")
' WScript.Echo user(0) & user(1) & user(2) & user(3) & user(4) & "|"
i = i + 1
WScript.Echo present & "|"
Next
End Sub
Sub readfile(strFile)
dim fs,objTextFile
set fs=CreateObject("Scripting.FileSystemObject")
If (fs.FileExists( strFile)) Then
dim userArrayList
set objTextFile = fs.OpenTextFile(strFile)
Set userArrayList = CreateObject( "System.Collections.ArrayList" )
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
userArrayList.add strNextLine
Loop
objTextFile.Close
set objTextFile = Nothing
set fs = Nothing
set readfile = userArrayList
Else
'Alert User
WScript.Echo("File does not exist!")
WScript.Quit()
End If
end Sub
Your
set arr = readfile( FileName )
implies that readfile() is a Function (returning an ArrayList). But you define
Sub readfile(strFile)
...
set readfile = userArrayList
...
end Sub
You may try to change this to
Function readfile(strFile)
...
set readfile = userArrayList
...
End Function
ADDED:
The task "Read a files' lines into an array" can be done in a much more simple way:
cscript fitoar.vbs
0 Option Explicit
1 Dim a : a = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile("fitoar.vbs").ReadAll(), vbCrLf)
2 Dim l
3 For l = 0 To UBound(a)
4 WScript.Echo l, a(l)
5 Next
6