I have a case in which I have field name as Order date for which I need to make it as always valid and it should be valid always.
Below is the script I tried.
Public Function getFolderDetails_FromPath_ForEmailInvoice(ByVal pXDoc As CASCADELib.CscXDocument) As String
On Error GoTo PROC_ERR
Const cProcName = "getFolderDetails_FromPath_ForEmailInvoice"
DbgOut(cProcName, Err, "Start")
Dim FullPath As String
Dim PathArry() As String
Dim FolderName As String
Dim FolderProp() As String
Dim xfolder As CscXFolder
Set xfolder = pXDoc.ParentFolder
While Not xfolder.IsRootFolder
Set xfolder = xfolder.ParentFolder
Wend
'Added below line for KTM testing
'FullPath="F:\EmailImport\chirag#gmail.com_08-01-2014_00-00-00\Demo_Manipulados_02.TIF"
If xfolder.XValues.ItemExists("AC_FIELD_OriginalFileName") Then
FullPath= xfolder.XValues.ItemByName("AC_FIELD_OriginalFileName").Value
End If
PathArry() = Split(FullPath,"\")
FolderName = PathArry(UBound(PathArry())-1)
FolderProp() = Split(FolderName,"_")
If CInt(UBound(FolderProp()))=2 Then
If(ValidateEmailAddress(FolderProp(0))) Then
pXDoc.Fields.ItemByName("Email_ID").Text = FolderProp(0)
pXDoc.Fields.ItemByName("Email_ID").ForcedValid = True
pXDoc.Fields.ItemByName("ReceiveDate").Text = FolderProp(1)
ValidationForm.Fields.ItemByName("ReceiveDate").Enabled = False
pXDoc.Fields.ItemByName("ReceiveDate").OriginalValid = True
pXDoc.Fields.ItemByName("Email_Time").Text = FolderProp(2)
pXDoc.Fields.ItemByName("Email_Time").ForcedValid = True
Else
pXDoc.Fields.ItemByName("Email_ID").Text = ""
pXDoc.Fields.ItemByName("Email_ID").ForcedValid = True
pXDoc.Fields.ItemByName("Email_Time").Text = ""
pXDoc.Fields.ItemByName("Email_Time").ForcedValid = True
End If
Else
pXDoc.Fields.ItemByName("Email_ID").Text = ""
pXDoc.Fields.ItemByName("Email_ID").ForcedValid = True
pXDoc.Fields.ItemByName("Email_Time").Text = ""
pXDoc.Fields.ItemByName("Email_Time").ForcedValid = True
End If
Use this property to make field valid always true:
pXDoc.Fields.ItemByName("Email_Time").ExtractionConfident = True
Related
Hi This is the exact function i am using while pulling the report from CMS R17. Error line is quoted in * Set cvsConn = New cvsConnection * stars.
Function CMSConn(sUserID As String, sPassword As String, sServerIP As String)
Dim cvsApp As cvsApplication
Dim cvsSrv As cvsServer
Dim cvsConn As cvsConnection
Dim iServer As Integer
Dim bConnected As Boolean
bConnected = False
Set cvsApp = New cvsApplication
Set cvsSrv = New cvsServer
***Set cvsConn = New cvsConnection***
'Checks to see if already connected to server
For iServer = 1 To cvsApp.Servers.Count
Set cvsSrv = cvsApp.Servers(iServer)
If cvsSrv.ServerKey Like "*\" & sServerIP & "\*\*\*" Then
bConnected = True
'MsgBox "Avaya Connected! Click OK to proceed."
Exit For
End If
Next iServer
'Initiates connection if one not already established
If bConnected = False Then
If cvsApp.CreateServer(sUserID, sPassword, "", sServerIP, False, "ENU",
cvsSrv, cvsConn) Then
If cvsConn.Login(sUserID, sPassword, sServerIP, "ENU") Then
End If
End If
End If
'Executes CMS report
Dim cvsRepInfo As Object
Dim cvsRepProp As Object
Dim cvsLog As Object
Dim b As Boolean
On Error Resume Next
cvsSrv.Reports.ACD = 1
Set cvsRepInfo = cvsSrv.Reports.Reports("Historical\Designer\Skill Interval SvcLvl")
If cvsRepInfo Is Nothing Then
If cvsSrv.Interactive Then
MsgBox "The report was not found on ACD.", vbCritical Or vbOKOnly,
"Avaya CMS Supervisor"
Else
Set cvsLog = CreateObject("ACSERR.cvsLog")
cvsLog.AutoLogWrite "The report was not found on ACD."
Set cvsLog = Nothing
End If
Else
b = cvsSrv.Reports.CreateReport(cvsRepInfo, cvsRepProp)
If b Then
Application.DisplayAlerts = False
cvsRepProp.Window.Top = 40
cvsRepProp.Window.Left = 40
cvsRepProp.Window.Width = 40
cvsRepProp.Window.Height = 40
cvsRepProp.SetProperty "Splits/Skills",
ThisWorkbook.Sheets("DAILY").Range("x7").Value
cvsRepProp.SetProperty "Date",
ThisWorkbook.Sheets("DAILY").Range("x8").Value
cvsRepProp.SetProperty "Times",
ThisWorkbook.Sheets("DAILY").Range("x9").Value
b = cvsRepProp.ExportData("", 9, 0, False, True, True)
'Closes report
If bConnected = True Then
cvsRepProp.Quit
Else
If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove
cvsRepProp.TaskID
End If
Set cvsRepProp = Nothing
End If
End If
'Terminates server instance and connection
Set cvsRepInfo = Nothing
If Not cvsSrv.Interactive Then cvsApp.Servers.Remove cvsSrv.ServerKey
If bConnected = False Then
cvsConn.Logout
cvsConn.Disconnect
cvsSrv.Connected = False
End If
Set cvsConn = Nothing
Set cvsSrv = Nothing
Set cvsApp = Nothing
End Function
End Sub
I'm having an issue where I mark several rows for deletion within a loop, but when it gets to a certain point in the loop, the rows actually start to be removed.
As you can see what I'm basically doing is checking if the row needs to be deleted and if so, add it to a new table and delete it.
The problem is this works for the first 60 ish rows, then all of a sudden the rows appear to actually be removed and it eventually throws a row with that index doesn't exist error (at 65).
The original table is a list of contacts with firstname, lastname, email and company, with 70 records.
I tried to cut the list in half, but then the issue started happening at around row 23.
dtSelectCompany = dt_data.Clone
Dim s_company As String
Dim b_add As Boolean
Dim dtCompanies As Data.DataTable
For i = 0 To dt_data.Rows.Count - 1
b_add = False
s_company = dt_data.Rows(i).Item(columnsDictionary("company")).ToString
If s_company = "" Then : b_add = True
Else
dtCompanies = crm_functions.getCompaniesByName(s_company.Replace(" ", "%"))
If dtCompanies.Rows.Count > 1 Then : b_add = True
ElseIf dtCompanies.Rows.Count = 1 Then
dt_data.Rows(i).Item(columnsDictionary("company")) = dtCompanies.Rows(0).Item("id")
Else : b_add = True
End If
End If
If b_add Then
Dim temp_row As Data.DataRow = dtSelectCompany.NewRow
temp_row.ItemArray = dt_data.Rows(i).ItemArray.Clone()
temp_row.Item("fullName") = temp_row.Item(columnsDictionary("firstname")) & " " & temp_row.Item(columnsDictionary("lastname"))
dtSelectCompany.Rows.Add(temp_row)
dt_data.Rows(i).Delete()
End If
Next
Instead of a counter, use a datarow, for example:
dtSelectCompany = dt_data.Clone
Dim s_company As String
Dim b_add As Boolean
Dim dtCompanies As Data.DataTable
Dim MyDataRow as DataRow
For Each MyDataRow IN dt_data.Rows
b_add = False
s_company = MyDataRow("company").ToString
If s_company = "" Then : b_add = True
Else
' not sure what crm_functions is, so left this alone
dtCompanies = crm_functions.getCompaniesByName(s_company.Replace(" ", "%"))
If dtCompanies.Rows.Count > 1 Then : b_add = True
ElseIf dtCompanies.Rows.Count = 1 Then
MyDataRow("company")) = dtCompanies.Rows(0).Item("id")
Else : b_add = True
End If
End If
If b_add Then
Dim temp_row As Data.DataRow = dtSelectCompany.NewRow
temp_row = MyDataRow
temp_row.Item("fullName") = temp_row.Item(columnsDictionary("firstname")) & " " & temp_row.Item(columnsDictionary("lastname"))
dtSelectCompany.Rows.Add(temp_row)
MyDataRow.Delete()
End If
Next
Wrote this off the top of my head, so .....
So today in my Computer Programming Class, we created a project called CaseStudy. I saw a way to make the program have more replay value. I decided to morph the code and interface to be like a Hangman game. I've got the limbs to appear, but only after clicking Ok on the messageBox.
I'm wondering if anyone has a way to make these limbs appear in real time.
Here is the important code:
Dim SECRET_WORD As String = newSecretWord
Const FLAG As Char = "!"
Const GUESS_PROMPT As String = "Enter a letter or " & FLAG & " to guess word:"
Dim numGuesses As Integer = 0
Dim letterGuess As Char
Dim wordGuess As String
Dim tempWord As String
Dim endGame As Boolean
Dim wordGuessedSoFar As String = ""
Dim lenght As Integer = SECRET_WORD.Length
wordGuessedSoFar = wordGuessedSoFar.PadLeft(lenght, "_")
Me.lblSecretWord.Text = wordGuessedSoFar
Dim tempLetterGuess = InputBox(GUESS_PROMPT, Me.Text)
If tempLetterGuess = Nothing Then
endGame = True
Else
letterGuess = tempLetterGuess
End If
Do While letterGuess <> FLAG And wordGuessedSoFar <> SECRET_WORD And Not endGame
numGuesses += 1
For letterPos As Integer = 0 To SECRET_WORD.Length - 1
If SECRET_WORD.Chars(letterPos) = Char.ToUpper(letterGuess) Then
tempWord = wordGuessedSoFar.Remove(letterPos, 1)
wordGuessedSoFar = tempWord.Insert(letterPos, Char.ToUpper(letterGuess))
Me.lblSecretWord.Text = wordGuessedSoFar
End If
Next letterPos
If wordGuessedSoFar <> SECRET_WORD Then
tempLetterGuess = InputBox(GUESS_PROMPT, Me.Text)
If tempLetterGuess = Nothing Then
endGame = True
Else
letterGuess = tempLetterGuess
End If
End If
Loop
If wordGuessedSoFar = SECRET_WORD Then
MessageBox.Show("You guessed it in " & numGuesses & " guesses!")
ElseIf letterGuess = FLAG Then
wordGuess = InputBox("Enter a word: ", Me.Text)
If wordGuess.ToUpper = SECRET_WORD Then
MessageBox.Show("You guessed it in " & numGuesses & " guesses!")
Me.lblSecretWord.Text = SECRET_WORD
Else
MessageBox.Show("Sorry, you lose.")
End If
Else
MessageBox.Show("Game over.")
lblSecretWord.Text = Nothing
End If
Dim place As Integer = SECRET_WORD.Length - 1
If tempLetterGuess <> SECRET_WORD.Chars(place) Then
numWrong += 1
End If
If numWrong = 1 Then
picHead.Visible = True
End If
If numWrong = 2 Then
picBody.Visible = True
End If
End Sub
End Class
I can take any other pictures if you'd like.
If I'm understanding you right, you want to show your "pictures" before the user sees the message. If so, you need to move the following code to an area just before your MessageBox and just after the InputBox:
Dim place As Integer = SECRET_WORD.Length - 1
If tempLetterGuess <> SECRET_WORD.Chars(place) Then
numWrong += 1
End If
If numWrong = 1 Then
picHead.Visible = True
End If
If numWrong = 2 Then
picBody.Visible = True
End If
Code for reading and splitting from file:
Public Sub LoadAccount()
currentfilereader = New StreamReader(filename)
Dim Seperator As Char = " "c
For count As Integer = 0 To NumUsers - 1
textstring = currentfilereader.ReadLine
Dim words() As String = currentfilereader.ReadLine.Split(Seperator)
Username = words(0)
Password = words(1)
If words(2) = "1" Then
AccessGranted = True
Else
AccessGranted = False
End If
Users(count, 0) = Username
Users(count, 1) = Password
Users(count, 2) = AccessGranted
Next
currentfilereader.Close()
End Sub
Code for logging in:
Public Sub Login()
Dim InvalidUsername, InvalidPassword As Boolean
InvalidUsername = True
InvalidPassword = True
LoginName = Form1.tbun.Text
LoginPassword = Form1.tbpw.Text
For count As Integer = 0 To NumUsers - 1
If LoginName = Users(count, 0) Then
InvalidUsername = False
If LoginPassword = Users(count, 1) Then
InvalidPassword = False
CurrentUsername = LoginName
CurrentPassword = LoginPassword
CurrentAccessGranted = Users(count, 2)
loggedin = True
Else
MsgBox("Invalid Password")
End If
Else
MsgBox("Invalid Username")
End If
Next
End Sub
Code for calculating number of users:
Public Sub NumberOfUsers()
currentfilereader = New StreamReader(filename)
NumUsers = File.ReadAllLines("Accounts.txt").Length
MsgBox("There are " & NumUsers & " users")
End Sub
I have added a MsgBox to show the number of users to make sure all is working fine which returns the value of 2, since I currently have 2 lines in the text file, "a a 1" and "b b 1".
However when this line runs, Dim words() As String = currentfilereader.ReadLine.Split(Seperator), it returns null.
The purpose of subtracting 1 from the NumUsers in the count is since the count starts at zero along with the array. Meaning that if I didn't it would check 3 times if there is only 2 users in the file. But I just can't seem to figure out what is wrong and why it is returning null.
You call ReadLine twice for each user:
textstring = currentfilereader.ReadLine
Dim words() As String = currentfilereader.ReadLine.Split(Seperator)
This means that for the first user you read both lines, and for the second user you read nothing, leading to the empty split array.
Replace
Dim words() As String = currentfilereader.ReadLine.Split(Seperator)
With
Dim words() As String = textstring.Split(Seperator)
I have a Vb App which saves data on my document
I have Console_Load program which creates 2 TXT file and validates the same as other fragment of codes looks for the same TXT files but when i install this app post publish it throws an error on Console load "Error : conversion from string "C/user/mydocument" to type boolean is not valid"
Below are the code:-
Dim chkuser As String
Dim chkpass As String
Dim LoadUser As String
Dim LoadPass As String
Dim userexist As Boolean
Dim passexist As Boolean
Dim fullFilePathu As String
Dim fullFilePathp As String
With My.Computer.FileSystem
fullFilePathu = .CombinePath(.SpecialDirectories.MyDocuments, "user.txt")
fullFilePathp = .CombinePath(.SpecialDirectories.MyDocuments, "user.txt")
If fullFilePathp = False Then
My.Computer.FileSystem.WriteAllText(fullFilePathu, String.Empty, False)
My.Computer.FileSystem.WriteAllText(fullFilePathp, String.Empty, False)
End If
chkpass = .CombinePath(.SpecialDirectories.MyDocuments, "pass.txt")
chkuser = .CombinePath(.SpecialDirectories.MyDocuments, "user.txt")
My.Computer.FileSystem.WriteAllText("chkpass", String.Empty, False)
My.Computer.FileSystem.WriteAllText("chkuser", String.Empty, False)
LoadUser = .ReadAllText(chkuser)
LoadPass = .ReadAllText(chkpass)
userexist = My.Computer.FileSystem.FileExists(chkuser)
passexist = My.Computer.FileSystem.FileExists(chkpass)
If userexist = True Then
UserName.Text = LoadUser
PASSWORD.Text = LoadPass
LOGIN.Enabled = False
AutoON.Enabled = False
statusIO.Text = "Logged In"
LOGIN.Enabled = False
LOGOFF.Enabled = True
PS i am a newbie
Thanks in advance
As #Plutonix points out, Line #12:
If fullFilePathp = False Then
is causing the exception since a string cannot be compared to a Boolean. Try changing it to
If Not My.Computer.FileSystem.FileExists(fullFilePathp) Then
Hopefully this won't be too wonky. ;-)