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:
198:
199:
200:
201:
202:
|
Public Class frmCreateProject
Private Sub frmCreateProject_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'PrjctIngtry_ProjectsDataSet.vwClientList' table. You can move, or remove it, as needed.
Me.VwClientListTableAdapter.Fill(Me.PrjctIngtry_ProjectsDataSet.vwClientList)
'TODO: This line of code loads data into the 'PrjctIngtry_ProjectsDataSet.vwAssociates' table. You can move, or remove it, as needed.
Me.VwAssociatesTableAdapter.Fill(Me.PrjctIngtry_ProjectsDataSet.vwAssociates)
End Sub
Function ClientPath()
Dim ClientFile As String
Dim strClient
strClient = Me.cboClients.Text
ClientFile = ""
If strClient = String.Empty Then
MsgBox("Please select Client", MsgBoxStyle.OkOnly, "Alert")
ClientPath = ""
Exit Function
Else
Select Case strClient
Case "ABT"
ClientFile = "Abbott"
Case "AGN"
ClientFile = "Allergan"
Case "AMG"
ClientFile = "Amgen"
Case "AZ"
ClientFile = "AstraZeneca"
Case "BAY"
ClientFile = "Bayer"
Case "BI"
ClientFile = "Boe-Ingel"
Case "BMS"
ClientFile = "BMS"
Case "BVL"
ClientFile = "Biovail"
Case "CTCR"
ClientFile = "Centocor"
Case "DCS"
ClientFile = "Daiichi Sankyo"
Case "FRX"
ClientFile = "Forest"
Case "FUJ"
ClientFile = "Fujisawa"
Case "GENE"
ClientFile = "Genentech"
Case "GSK"
ClientFile = "GlaxoSmithKline"
Case "JAN"
ClientFile = "JNJ-Janssen"
Case "JNJ"
ClientFile = "JNJ-HCS Other"
Case "LLY"
ClientFile = "Eli Lilly"
Case "MRK"
ClientFile = "Merck"
Case "NVS"
ClientFile = "Novartis"
Case "OMP"
ClientFile = "JNJ-OMP"
Case "PFE"
ClientFile = "Pfizer"
Case "PNG"
ClientFile = "Proctor & Gamble"
Case "RCHE"
ClientFile = "Roche"
Case "SA-AVE"
ClientFile = "Sanofi-Aventis"
Case "SCZ"
ClientFile = "Schwarz"
Case "SEP"
ClientFile = "Sepracor"
Case "SER"
ClientFile = "Serono"
Case "SPG"
ClientFile = "Schering-Plough"
Case "TAK"
ClientFile = "Takeda"
Case "TAP"
ClientFile = "TAP"
Case "WYE"
ClientFile = "Wyeth"
Case "AmerSrce"
ClientFile = "Amerisource"
Case "Amyln"
ClientFile = "Amylin"
Case "Astellas"
ClientFile = "Astellas"
Case "BIOG"
ClientFile = "Biogen"
Case "COLLAG"
ClientFile = "Collagenex"
Case "EISAI"
ClientFile = "Eisai"
Case "MEDIM"
ClientFile = "MedImmune"
End Select
End If
ClientPath = ClientFile
End Function
Private Sub btnCreate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCreate.Click
Dim bolRepeat As Boolean
Dim strProject, strClient, strPL, ClientFilePath
strProject = Me.txtDescriptionCode.Text
strClient = Me.cboClients.Text
strPL = Me.cboProjectLeader.Text
bolRepeat = False
Do Until bolRepeat
bolRepeat = True
If InStr(strProject, "/") <> 0 Then
bolRepeat = False
End If
If InStr(strProject, "\") <> 0 Then
bolRepeat = False
End If
If InStr(strProject, ":") <> 0 Then
bolRepeat = False
End If
If InStr(strProject, "*") <> 0 Then
bolRepeat = False
End If
If InStr(strProject, "?") <> 0 Then
bolRepeat = False
End If
If InStr(strProject, "<") <> 0 Then
bolRepeat = False
End If
If InStr(strProject, ">") <> 0 Then
bolRepeat = False
End If
If InStr(strProject, "|") <> 0 Then
bolRepeat = False
End If
If bolRepeat = False Then
MsgBox("A file/folder name cannot contain the following characters: \ / : * ? < > | ", MsgBoxStyle.OkOnly, "Alert")
Exit Sub
End If
Loop
If strProject = String.Empty Then
MsgBox("Please enter a Description Code", MsgBoxStyle.OkOnly, "Alert")
Exit Sub
End If
strProject = Trim(strClient) + Trim(".") + Trim(strProject) + Trim("-08(") + Trim(strPL) + Trim(")")
Dim strProjectsDir, strnewProjectDir, strProjectFolder
Dim objShell
Dim fsoAll
'Dim intParen
'Create Filesystem and Shell Objects
fsoAll = CreateObject("Scripting.FileSystemObject")
objShell = CreateObject("wscript.Shell")
ClientFilePath = ClientPath()
'Find out the user's base dir, and where we are installing from
strnewProjectDir = "N:\Single Client Projects\!Copy Folder (Project Code) Single Client Project"
strProjectsDir = "N:\Single Client Projects\" & ClientFilePath & "\Proposals"
strProjectFolder = strProjectsDir & "\" & strProject
' Check whether the file alrady exists.
If fsoAll.FolderExists(strProjectFolder) Then
MsgBox("Error: " + strProjectFolder + " already exists, exiting.", MsgBoxStyle.OkOnly, "Folder Exists")
Exit Sub
Else
' Copy New Project Folder to Single Client Projects Folder
fsoAll.CopyFolder(strnewProjectDir, strProjectFolder, False)
End If
If Err.Number <> 0 Then
' Write error message
'filInstall.WriteLine(strDate & " " & strUserName & " " & "Error: " & Err.Number & " " & Err.Description)
MsgBox("Error " + Err.Number + ": " + Err.Description + vbCrLf + "Project Folder NOT successfully created, please see a Database Coordinator", MsgBoxStyle.OkOnly, "Error")
Else
' Write success in install log
'filInstall.WriteLine(strDate & " " & strUserName & " " & "Success")
MsgBox("Project Folder for " & strProject & " created successfully!", MsgBoxStyle.OkOnly, "Success")
End If
objShell = Nothing
fsoAll = Nothing
End Sub
End Class
|
