1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
|
Option Explicit
'///////////////User Input/////////////////////////////////////////////////////////////////////
'declare variables
Dim Prognym, CurDir
'Get current directory
CurDir = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
If Right(CurDir, 1) <> "\" Then CurDir = CurDir & "\"
'Get program loc and acronym to verify directory existence
Prognym = InputBox("Enter Program Location and Acronym " & vbcrlf & vbcrlf & _
"Follow this Example: CNLA_PROGRAM" & vbcrlf & vbcrlf & _
"If you leave blank or cancel, the script will exit.")
'cancel if blank entry
If Prognym = "" Then WScript.Quit
If Right(Prognym, 1) = "\" Then Prognym = Left(Prognym, Len(Prognym) - 1)
'///////////////Verify Directory Existence/////////////////////////////////////////////////////
'declare variables
Dim DestDir, oFSO1
'define variables
DestDir = CurDir&prognym&"\"
Set oFSO1 = CreateObject("Scripting.FileSystemObject")
'check for directory existence and quit script if needed, echo to user
If Not oFSO1.FolderExists(DestDir) Then
WScript.Echo "DestDir does not exist!! Check your spelling"
WScript.Quit
End If
'check for directory existence and echo to user
If oFSO1.FolderExists(DestDir) Then
'WScript.Echo "Folder Exists - Click OK to continue"
End If
'clear variables
Set oFSO1 = nothing
'/////////////Copy Template File to Destination Directory/////////////////////////////////////////
'declare variables
Dim oFSO2, strCurTemplateXLS, strDestTemplateXLS
'define variables
strCurTemplateXLS = CurDir& "Prog_List_Template.xls"
strDestTemplateXLS = DestDir& "Prog_List_Template.xls"
Set oFSO2 = CreateObject("Scripting.FileSystemObject")
'just checking for template file existence in current directory, script quits if true
If Not oFSO2.FileExists(strCurTemplateXLS) Then
WScript.Echo "The template file is missing. " & vbcrlf & vbcrlf & _
"Place the template file in " & CurDir & vbcrlf & _
"and re-run VBScript_Installed_Progs_Excel_Transfer.vbs" & vbcrlf & vbcrlf & _
"The template file must be named Prog_List_Template.xls"
WScript.Quit
End If
'just checking to see if the template file exists in the destination directory already,
'deletes template file in destination directory if true, which allows copying new template to destination
If oFSO2.FileExists(strDestTemplateXLS) Then
oFSO2.DeleteFile(strDestTemplateXLS)
'WScript.Echo "Template file existed in DestDir and was deleted"
End If
'copy template file from current directory to destination directory
If oFSO2.FileExists(strCurTemplateXLS) Then
oFSO2.CopyFile strCurTemplateXLS, DestDir
'WScript.Echo "Template file exists in CurDir and copied to " & DestDir
End If
'clear variables
Set oFSO2 = nothing
'/////////////Keep only one .old XLS and Rename Template///////////////////////////////////////
'declare variables
Dim oFSO3, strExistingXLS, strExistingOldXLS, strExistingXLS2Old, strNewXLS
'define variables
Set oFSO3 = CreateObject("Scripting.FileSystemObject")
'Set oFSO4 = CreateObject("Scripting.FileSystemObject")
'Set oFolder1 = oFSO3.GetFolder(DestDir)
'Set oFiles = oFolder1.Files
strNewXLS = DestDir&Prognym& "_Installed_Progs.xls"
strExistingXLS = DestDir&Prognym& "_Installed_Progs.xls"
strExistingOldXLS = DestDir&Prognym& "_Installed_Progs.xls.old"
strExistingXLS2Old = DestDir&Prognym& "_Installed_Progs.xls.old"
'check for new and old, rename to destination
If oFSO3.FileExists(strExistingXLS) And oFSO3.FileExists(strExistingOldXLS) Then
oFSO3.DeleteFile(strExistingOldXLS)
oFSO3.MoveFile strExistingXLS, strExistingXLS2Old
oFSO3.MoveFile strDestTemplateXLS, strNewXLS
'WScript.Echo "both existed"
End If
'check for new only, rename to destination
If oFSO3.FileExists(strExistingXLS) And Not oFSO3.FileExists(strExistingOldXLS) Then
oFSO3.MoveFile strExistingXLS, strExistingXLS2Old
oFSO3.MoveFile strDestTemplateXLS, strNewXLS
'WScript.Echo "one existed"
End If
'check for neither, rename to destination
If Not oFSO3.FileExists(strExistingXLS) And Not oFSO3.FileExists(strExistingOldXLS) Then
oFSO3.MoveFile strDestTemplateXLS, strNewXLS
'WScript.Echo "not both existed"
End If
'check for old only, rename to destination
If Not oFSO3.FileExists(strExistingXLS) And oFSO3.FileExists(strExistingOldXLS) Then
oFSO3.MoveFile strDestTemplateXLS, strNewXLS
'WScript.Echo "only old existed"
End If
'clear variables
Set oFSO3 = nothing
Set strExistingXLS = nothing
Set strExistingOldXLS = nothing
Set strExistingXLS2Old = nothing
'/////////////Open .tsv and copy to XLS on its own sheet///////////////////////////////////////
'declare variables
Dim oNewXLS, oTSV, oExcel, oFSO4, oFolder, oFile, oFiles, sheetCount, sheetName, addSheet
'define variables
Set oExcel = CreateObject("Excel.Application")
Set oFSO4 = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO4.GetFolder(DestDir)
Set oFiles = oFolder.Files
'Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, True)
Set oNewXLS = oExcel.Workbooks.Open(strNewXLS, False, False)
sheetCount = 2
'excel options
oExcel.DisplayAlerts = 0
'oExcel.Visible = True
oExcel.Visible = False
'////////////loop through .tsv and add contents to worksheets in NewXLS////////////////////////
For Each oFile In oFiles
If Right(oFile.Name, 4) = ".tsv" Then
'define variables
Set oTSV = oExcel.Workbooks.Open(DestDir& oFile.Name, False, True)
Set addSheet = oNewXLS.Sheets.Add( , oNewXLS.WorkSheets(oNewXLS.WorkSheets.Count))
'perform adding sheets and naming them
sheetName = Left(oFile.Name, Len(oFile.Name) - 4)
sheetName = Right(sheetName, (Len(sheetName) - (InStrRev(sheetName, "_"))))
oTSV.Sheets(1).Cells.Copy oNewXLS.Sheets(sheetCount).Range("A1")
oTSV.Close False
oNewXLS.Sheets(sheetCount).Name = sheetName
sheetCount = sheetCount + 1
End IF
Next
oExcel.Run "fmatWBOOK"
oExcel.DisplayAlerts = False
oNewXLS.SaveAs strNewXLS
oExcel.DisplayAlerts = True
oNewXLS.Close
oExcel.Quit
'clear variables
Set oNewXLS = nothing
Set oTSV = nothing
Set oExcel = nothing
set oFSO4 = nothing
set oFolder = nothing
set oFile = nothing
Set oFiles = nothing
Set sheetCount = nothing
Set sheetName = nothing
Set addSheet = nothing
'clear leftover variables
Set Prognym = nothing
Set CurDir = nothing
Set DestDir = nothing
Set strCurTemplateXLS = nothing
Set strDestTemplateXLS = nothing
Set strNewXLS = nothing
WScript.Echo "complete"
|
