I am working on a project and had to refer to a already completed project.While going through[enter image description here][1] it I encountered a problem and wasn't able to understand the code
I want to know what is adosetup doing.
Msmt_system is table name
While msmt_sys_desc and msmt_sys_val are columns in msmt_system
dbcBoLC is datacombobox
How does datacombo know from which table to access data?
Call adoSetup(AdoCom, "Msmt_System", True, dbcBoLC, "Msmt_Sys_Desc",
"Msmt_Sys_val")
Call dbcBoLC_Click(1)
'in another file:
Public Sub adoSetup(adoCtrl As Adodc, sRecSrc As String,
bLinkAdoCtrl As Boolean,
Optional dCombo As DataCombo,
Optional sListField As String,
Optional sBoundCol As String)
'Added On: 25/07/2003
sAppPath = App.Path & "\MultiGauging.mdb" 'Store the Application Path
sDbConn_String = "DBQ=" & sAppPath & ";Driver={Microsoft Access Driver (*.mdb)};pwd=*****;UID=admin;UserCommitSync=Yes;"
'Begin: Setup the connection string and apply to datacontrol
With adoCtrl
.ConnectionString = sDbConn_String
.RecordSource = sRecSrc
.Refresh
End With
'End: Setup the connection string and apply to datacontrol
'Begin: Setup the corresponding combo box
If bLinkAdoCtrl Then
Set dCombo.RowSource = adoCtrl
dCombo.ListField = sListField
dCombo.BoundColumn = sBoundCol
If Not (adoCtrl.Recordset.EOF Or adoCtrl.Recordset.BOF) Then
adoCtrl.Recordset.MoveFirst
dCombo.BoundText = adoCtrl.Recordset(sBoundCol)
End If
End If
'End: Setup the corresponding combo box
End Sub
In your call:
Call adoSetup(AdoCom, "Msmt_System", True, dbcBoLC, . . .
The table name is the 2nd argument. That is how it knows which table (recordsource) to use. Your sub adoSetup just establishes a connection (ConnectionString = sDbConn_String) queries a table (RecordSource = sRecSrc) then it attaches the data to a combo box (arg 4 to this sub: dbcBoLC). The datacombo just uses whatever table was set in adoCtrl.
Related
Please, I had already create à variable Environ("MYXLSPATH")
Dim vr As String
vr = "SETX MYXLSPATH """ & ThisWorkbook.FullName & """"
Call Shell(vr)
And now, I want to replace the content of this variable by: "NAME"
Dim vr As String
Environ.RemoveItem ("MYXLSPATH")
vr = "SETX MYXLSPATH "" NAME """
Call Shell(vr)
But, It doesn't work, can you help me please ?
The second set of code should be:
Dim vr As String
vr = "SETX MYXLSPATH ""NAME"""
Call Shell(vr)
I've made two changes:
Removed the Environ.RemoveItem line. It's not needed and seems to be problematic.
Removed the space either side of NAME. So this means the environment variable is set to NAME and not NAME
End result:
Instead of running a CMD.EXE command you can call in to the Shell object to get to the environment variables directly. To replace, just call the set again.
Here are procedures to set and get:
Option Explicit
'#Description("Set environment variable value. Defaults to user space. System space requires elevated process to modify.")
Public Sub EnvironSetItem(ByVal environVariable As String, ByVal newValue As String, Optional ByVal strType As String = "User")
With CreateObject("WScript.Shell").Environment(strType)
.Item(environVariable) = newValue
End With
End Sub
'#Description("Get environment variable value. Defaults to userspace.")
Public Function EnvironGetItem(ByVal environVariable As String, Optional ByVal strType As String = "User") As String
With CreateObject("WScript.Shell").Environment(strType)
EnvironGetItem = .Item(environVariable)
End With
End Function
I am trying to set the Text property of a dynamically created text box using a variable name, but when I use the Me.Controls(variable name).Text, I'm getting an error saying I need to set it up as "New". The name property of the text box, using a variable, was set when it was created but I don't seem to be able to retrieve using the same name.
Private Sub Example(panposition As Integer)
Dim tbfile = New TextBox()
Dim lineExample As Integer = 2
' creating a text box with a variable name
Controls.Add(tbfile) ' create the new textbox to hold the file name
tbfile.Name = "tbfile" + panposition.ToString
tbfile.Location = New Point(85, tvposition)
tbfile.Size = New Size(155, 20)
tbfile.Text = "file name"
tbfile.TextAlign = HorizontalAlignment.Left
tbfile.HideSelection = False
tbfile.TabStop = False
tbfile.AllowDrop = False
tbfile.Visible = True
' trying to update the text in the text box using file name and text retrieved from an array
Me.Controls.(arrTextVals(1, lineExample)).Text = arrTextVals(2, lineExample)
End Sub
I think the problem is in line:
Me.Controls.(arrTextVals(1, lineExample)).Text = arrTextVals(2, lineExample)
The correct way to address a control in this way is to make a reference like this
Me.Controls(i).Text = arrTextVals(2, lineExample)
where i is an integer or using the name of the desired control which in your case could be
Me.Controls(arrTextVals(1, lineExample)).Text = arrTextVals(2, lineExample)
Of course i suppose as you mentioned before that arrTextVals is a string array
Edit:
You have a dot after Me.Controls.( <- never put a . before a bracket.
I have the following code but I need to adjust. I want the user to select a particular folder from within a project. Imagine the path "C:\Project\SomeOtherFolder\WINDOW". The below code only fills the text box if the have selected the "WINDOW" folder. I'm just using this as a check for the user, but I actually want the text box to fill with "Project".
Using fb As New FolderBrowserDialog
If fb.ShowDialog = Windows.Forms.DialogResult.OK AndAlso _
(IO.Path.GetFileName(fb.SelectedPath) = "WINDOW") Then
TextBox1.Text = IO.Path.GetFileName(fb.SelectedPath)
Else
Exit Sub
End If
End Using
How can I accomplish this please? Many Thanks!!!
This UDF, should give you what you need. I have created the function to return the name of the folder up from a specific folder location. I have included some optional parameters so you could (if required) change the requirement.
Public Function GetFolderName(FolderPath As String, _
Optional endPath As String = "WINDOW", _
Optional moveUp As Integer = 2) As String
Dim tmpArr() As String, retStr As String
tmpArr = Split(FolderPath, "\")
If InStr(FolderPath, endPath) <> 0 And moveUp <= UBound(tmpArr) Then
retStr = tmpArr(UBound(tmpArr) - moveUp)
End If
GetFolderName = retStr
End Function
So the code walk through. You send in the Path you obtain in the previous step and then you simply call the function as,
TextBox1.Text = GetFolderName(fb.SelectedPath)
'Or - However this is redundant as the Optional Parameters are declared as such by default
TextBox1.Text = GetFolderName(fb.SelectedPath, "WINDOW", 2)
The above would populate your text box as "Project". Hope this helps !
Problem:
Trying to create an SSIS job using SQL Server 2005 BIDS. Job includes a Script Task and an Email Task. The script task fails at the last step and gets this error:
Failed to open a rowset. Details: ADO Error Code: 0x Source: Microsoft
OLE DB Provider for SQL Server Description: Procedure or function
'usp_xtal_InHouse_Penetration_Summary' expects parameter '#DateStart',
which was not supplied.
SQL State: 42000 Native Error: Failed to open a rowset. Error in File
C:\DOCUME~1\TEMP~1.SUM\LOCALS~1\Temp\1\auto_Inhouse_Leads_Penetration
{5DA4C113-6AFC-4EB2-94E8-7D0F12E03C52}.rpt: Failed to open a rowset.
I believe the issue is due to the report being called is running off a Stored procedure and I'm not sure if the report will actually pass the params to the SP. The reason I think this is because the error is a SQL error stating the very first param it is looking for is not being supplied. The SP is only looking for the params being declared in this script and the script is declaring, setting, and loading the params in the exact same order as the SP.
We have other reports running running off similar SSIS jobs but none of them are using a SP.
Any thoughts would be appreciated.
The following script I am providing has several msgbox()'s at various places checking to see if variables are being loaded correctly and that the script executes to that point. It fails with the above mentioned error at the last one.
Public Class ScriptMain
Public Sub Main()
'
Dim CrystalReportViewer1 As New CrystalDecisions.Windows.Forms.CrystalReportViewer
Dim DiskOpts1 As New CrystalDecisions.Shared.DiskFileDestinationOptions
Dim myExportOptions1 As New CrystalDecisions.Shared.ExportOptions
DiskOpts1.DiskFileName = "\\10.200.0.7\c$\Jobs\Arrivals\WeeklyInhousePenetrationReport.pdf"
myExportOptions1.ExportFormatType = myExportOptions1.ExportFormatType.PortableDocFormat
myExportOptions1.ExportDestinationType = CrystalDecisions.Shared.ExportDestinationType.DiskFile
myExportOptions1.ExportDestinationOptions = DiskOpts1
' Verify the path to the Crystal Report's .RPT file:
Dim strReportPath1 As String = "\\10.200.0.7\c$\Jobs\Arrivals\auto_Inhouse_Leads_Penetration.rpt"
If Not System.IO.File.Exists(strReportPath1) Then
Throw (New Exception("Unable to locate report file:" & _
vbCrLf & strReportPath1))
End If
' Load the Crystal report's .RPT file:
Dim cr1 As New CrystalDecisions.CrystalReports.Engine.ReportDocument
'Dim ParamVal1 As New ParameterDiscreteValue
'Dim ParamVal2 As New ParameterDiscreteValue
Dim ParamVal3 As New ParameterDiscreteValue
Dim ParamVal4 As New ParameterDiscreteValue
Dim ParamVal5 As New ParameterDiscreteValue
cr1.Load(strReportPath1)
'Set the logon credentials of the main report---change these values
LogonToDatabase(cr1.Database.Tables, "SomeInstance", "SomeUserName", "SomePassword")
'ParamVal1.Value = 2
'ParamVal2.Value = False
ParamVal3.Value = DateAdd(DateInterval.Day, -15, Date.Today)
ParamVal4.Value = DateAdd(DateInterval.Day, -8, Date.Today)
ParamVal5.Value = "All"
MsgBox(ParamVal3.Value, , "Param 3") 'Good to here
'cr1.SetParameterValue("param_SiteID", ParamVal1)
'cr1.SetParameterValue("param_Detail", ParamVal2)
cr1.SetParameterValue("DateStart", ParamVal3)
cr1.SetParameterValue("DateEnd", ParamVal3)
cr1.SetParameterValue("Agent", ParamVal3)
MsgBox(ParamVal4.Value, , "ParamVal4") 'Good to here
' Set the CrystalReportViewer's appearance and set the ReportSource:
' This may not be needed but I kept them anyhow
CrystalReportViewer1.ShowRefreshButton = False
CrystalReportViewer1.ShowCloseButton = False
CrystalReportViewer1.ShowGroupTreeButton = False
CrystalReportViewer1.ReportSource = cr1
MsgBox(ParamVal5.Value, , "ParamVal5") 'Good to here
cr1.Export(myExportOptions1) ' Failing at this step
MsgBox(ParamVal3.Value, , "ParamVal3") 'Never gets here
'
Dts.TaskResult = Dts.Results.Success
End Sub
Private Sub LogonToDatabase(ByVal ReportTables As CrystalDecisions.CrystalReports.Engine.Tables, ByVal ServerName As String, ByVal UserId As String, ByVal Password As String)
' To Supply Logon Information to each and every Tables used in the Report
Dim myTable As CrystalDecisions.CrystalReports.Engine.Table
Dim myConnectionInfo As New CrystalDecisions.Shared.ConnectionInfo()
Dim myLogonInfo As New CrystalDecisions.Shared.TableLogOnInfo()
myConnectionInfo.UserID = UserId
myConnectionInfo.Password = Password
myConnectionInfo.ServerName = ServerName
myLogonInfo.ConnectionInfo = myConnectionInfo
For Each myTable In ReportTables
myTable.ApplyLogOnInfo(myLogonInfo)
Next
End Sub
End Class
I have a userform in 2008 vb express edition. A part number is created from user input via a concat string. I want to then check if a certain portion of the part number exists in the existing file names in a directory. Below is a more detailed explanation.
This is my code for creating a part number from the user input on the form.
L_PartNo.Text = String.Concat(CB_Type.Text, CB_Face.Text, "(", T_Width.Text, "x", T_Height.Text, ")", mount, T_Qty.Text, weep, serv)
I then have the following code to tell the user if the configuration (part no) they just created exists
L_Found.Visible = True
If File.Exists("Z:\Cut Sheets\TCS Products\BLANK OUT SIGN\" & (L_PartNo.Text) & ".pdf") Then
L_Found.Text = "This configuration exists"
Else
L_Found.Text = "This configuration does NOT exist"
End If
This is where I need help. The part no will look like this BX002(30x30)A1SS I want to compare 002(30x30) (just this part of the file name) to all the files in one directory. I want a yes or no answer to the existance and not a list of all matching files. The code below is everything I've tried, not all at the same time.
Dim b As Boolean
b = L_PartNo.Text.Contains(NewFace)
Dim NewFace As String = String.Concat(CB_Face.Text, "(", T_Width.Text, "x", T_Height.Text, ")")
Dim NewFace = L_PartNo.Text.Substring(2, 10)
If filename.Contains(NewFace) Then
lNewFace.Visible = False
Else
lNewFace.Visible = True
End If
The code below was a translation from the answer in C# but it does not work either
Dim contains As Boolean = Directory.EnumerateFiles(path).Any(Function(f) [String].Equals(f, "myfilethree", StringComparison.OrdinalIgnoreCase))
Here's an example of how you can do it without the fancy LINQ and Lambda which seem to be confusing you:
Public Function FileMatches(folderPath As String, filePattern As String, phrase As String) As Boolean
For Each fileName As String In Directory.GetFiles(folderPath, filePattern)
If fileName.Contains(phrase) Then
Return True
End If
Next
Return False
End Function
Or, if you need it to be case insensitive:
Public Function FileMatches(folderPath As String, filePattern As String, phrase As String) As Boolean
For Each fileName As String In Directory.GetFiles(folderPath, filePattern)
If fileName.ToLower().Contains(phrase.ToLower()) Then
Return True
End If
Next
Return False
End Function
You would call the method like this:
lNewFace.Visible = FileMatches(path, "*.pdf", NewFace)
Try this:
lNewFace.Visible = IO.Directory.GetFiles(path, "*.pdf").Where(Function(file) file. _
Substring(2, 10) = NewFace).FirstOrDefault Is Nothing
Consider that the substring function will throw an exception if its arguments exceed the length of the string it is parsing