I have the same line Repeating many times with small changes. i like to shorten it by using an array of objects
For example, instead of this code:
StartUpdateStr = "Update tblAfterSale SET "
EndUpdateStr = " WHERE IDAfterSale = "
IDAfterSale = Me.lblIDAfterSale.Caption
db.Execute StartUpdateStr & "Data1 = " & Me.Lable1.Caption & EndUpdateStr & IDAfterSale
db.Execute StartUpdateStr & "Data2 = " & Me.Lable2.Caption & EndUpdateStr & IDAfterSale
db.Execute StartUpdateStr & "Data3 = " & Me.Lable3.Caption & EndUpdateStr & IDAfterSale
db.Close
I'm looking for something like this:
Const dCaption = "Me.Lable1.Caption,Me.Lable2.Caption,Me.Lable3.Caption"
Public d(2) As Integer
Public Sub MyMacro()
Dim vntTemp As Variant
Dim intIndex As Integer
vntTemp = Split(lCaption, "d")
For intIndex = 0 To 2
db.Execute StartUpdateStr & "Data"& intIndex & " = " & d(intIndex) & EndUpdateStr & IDAfterSale
Next
End Sub
Can someone write me the right syntax?
Thank you
You can simply access the labels by name with Me("Label" & i)
For intIndex = 0 To 2
db.Execute StartUpdateStr & "Data" & intIndex & " = " _
& Me("Label" & (intIndex + 1)).Caption _
& EndUpdateStr & IDAfterSale
Next
I suppose you will be adding many labels in future. So can you use the below code
Private Sub PrintAllLabel()
For Each ctl In Me.Controls
If TypeName(ctl) = "Label" Then
db.Execute StartUpdateStr & "Data" & intIndex & " = " _
& ctl.Caption _
& EndUpdateStr & IDAfterSale
End If
Next ctl
End Sub
Related
Can someone please let me know what is wrong with this code? I have checked all lines for misspellings - this isnt the issue. All tables and queries are written as they exist in the db. Any help is appreciated.
Private Sub LoadArray()
'---------------------------
'---------------------------
'This procedure loads text into the 3rd column of the array
'---------------------------
'---------------------------
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsFiltered As DAO.Recordset
Dim strSQL As String
Dim i As Integer
strSQL = "SELECT tblProperties.Name, tbl1OpportuniyType.Type, qryPropertiesALLTypesALLTbls.TotalUnits, " _
& "qryPropertiesALLTypesALLTbls.EventStartTimeEachDay, qryPropertiesALLTypesALLTbls.EventEndTimeEachDay, " _
& "qryPropertiesALLTypesALLTbls.EventStartDate, qryPropertiesALLTypesALLTbls.EventStopDate, " _
& "qryPropertiesALLTypesALLTbls.TechOpsGroup, qryPropertiesALLTypesALLTbls.TechOpsResource " _
& "FROM tbl1OpportuniyType RIGHT JOIN (qryPropertiesALLTypesALLTbls INNER JOIN tblProperties ON qryPropertiesALLTypesALLTbls.[PropertyComplex_ID] = tblProperties.[PropertyComplex_ID]) ON tbl1OpportuniyType.[OpportunityType_ID] = tblProperties.OpportunityType " _
& "WHERE (((qryPropertiesALLTypesALLTbls.EventStartDate) Is Not Null));"
'Debug.Print strSQL
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
'This line ensures that the recordset is populated
If Not rs.BOF And Not rs.EOF Then
'Loops through the Array using dates for the filter
For i = LBound(myArray) To UBound(myArray)
If myArray(i, 1) Then
'Filters recordset with array dates
rs.Filter = "[EventStartDate]= " & myArray(i, 0)
'Open up new recordset based on filter
Set rsFiltered = rs.OpenRecordset
'Loop through new recordset
Do While (Not rsFiltered.EOF)
'Adds text to the 3rd column of the array
myArray(i, 2) = myArray(i, 2) & vbNewLine _
& rsFiltered!Type & " - " & vbNewLine _
& rsFiltered!Name & " " _
& rsFiltered!EventStartDate & " - " _
& rsFiltered!EventStopDate & " " _
& rsFiltered!EventStartTimeEachDay & " - " _
& rsFiltered!TechOpsGroup & " " _
& rsFiltered!TechOpsResource & " " _
& vbNewLine
rsFiltered.MoveNext
Loop
End If
Next i
End If
rsFiltered.Close
rs.Close
'Sets objects to nothing
Set rsFiltered = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
It isn't clear where myArray comes from, but the filter needs an adjustment to convert the date value to a string expression:
rs.Filter = "[EventStartDate] = #" & Format(myArray(i, 0), "yyyy\/mm\/dd") & "#"
I have done a bit of work on my code, and still unsure about how some of the code needs to be done in order to work.
So far I got a function named FunctionUp' coded, this is the code that will go in the following sequence:
If array of orders contains:
'A1G722
'A1G723
'A1G724
'A1G725
'A1G726
'A1G727
I added a reference to the current location as a query-string parameter named rowindex, so if the order passed in query-string is 'A1G725', the row index value will be 4, then function code will ideally browse in this sequence: 'A1G725', 'A1G724', 'A1G723', 'A1G722'
The code for the button:
.Write "<input type='submit' name='btnUp' value='Next' class='buttonRight' />"
The code that calls the function:
If Request("btnUp") = "Next" Then Call FuctionUp()
The code for the function:
Function FuctionUp()
Dim objConn
Dim objRS
Dim SQLOrderList
Dim SQLCurrentOrder
Dim currentorder
Dim previousorder
Dim sortby
Dim dtstart
Dim dtend
Dim index
currentorder = Trim(Request.QueryString("order"))
sortby = Request.QueryString("sortby")
currentorder = Request.QueryString("order")
dtstart = Request.QueryString("start")
dtend = Request.QueryString("end")
Set objRS = Server.CreateObject("ADODB.Recordset")
Set objConn = CreateObject("ADODB.Connection")
objConn.Open Application("conn_AWDSTAGE")
objRS.Cursortype = 3
SQLOrderList = "SELECT orderno" & _
" FROM _order" & _
" WHERE order_date >= '" & dtstart & "'" & _
" AND order_date < '" & dtend & "'" & _
" ORDER BY " & sortby
objRS.Open SQLOrderList, objConn
index = CINT(Request.QueryString("rowindex"))
If Not isNumeric(index) Or index = "" Then
index = 0
End If
'Get this to Array.
Dim iArray
Dim i
Dim sizeOfiArray
iArray = objRS.GetRows()
' sample of array contents after sql execution
'A1G722
'A1G723
'A1G724
'A1G725
'A1G726
'A1G727
sizeOfiArray = uBound(iArray) + 1
if not index >= (sizeOfiArray - 1) then previousorder = (index + 1)
If Not previousorder Is Nothing Then
Response.Redirect("~/printpreview.asp?order=" & previousorder(i) &
"&site=" & spiderSiteKey &
"&env=" & strEnv &
"&start=" & CDate(dtstart) &
"&end=" & CDate(dtend) &
"&rowindex=" & (index + 1) &
"&sortby=" & sortby)
Else
Response.Redirect("~/printpreview.asp?order=" & currentOrder.OrderID &
"&site=" & spiderSiteKey &
"&env=" & strEnv &
"&start=" & CDate(dtstart)) &
"&end=" & CDate(dtend) &
"&rowindex=" & (index) &
"&sortby=" & strSortBy &
"&LastRecord=Up")
End If
objRS.Close()
Set objRS = Nothing
objConn.Close()
Set objConn = Nothing
End Function
Wouldn't it be easier simply to get the next or previous orders directly from the database using SQL:
sSQLGetPrevOrder = "SELECT top(1) PREV.* " _
& " FROM [Order] PREV " _
& " JOIN ( " _
& " SELECT " & strOrderBy & " sortvalue, orderno " _
& " FROM Order WHERE orderno='" & strCurrentOrder & "' " _
& " ) CURR " _
& " ON PREV." & strOrderBy & " < CURR.sortvalue " _
& " OR ( PREV." & strOrderBy & " = CURR.sortvalue " _
& " AND PREV.orderno < CURR.orderno ) " _
& " ORDER BY PREV." & strOrderBy & " DESC, PREV.orderno DESC "
sSQLGetNextOrder = "SELECT top(1) NXT.* " _
& " FROM [Order] NXT " _
& " JOIN ( " _
& " SELECT " & strOrderBy & " sortvalue, orderno " _
& " FROM Order WHERE orderno='" & strCurrentOrder & "' " _
& " ) CURR " _
& " ON NXT." & strOrderBy & " > CURR.sortvalue " _
& " OR ( NXT." & strOrderBy & " = CURR.sortvalue " _
& " AND NXT.orderno > CURR.orderno ) " _
& " ORDER BY NXT." & strOrderBy & " ASC, NXT.orderno ASC "
(Apologies if this code has syntax errors, I have not been able to test it)
If orderno is always a number, you could omit the quote marks around strCurrentOrder.
Ok my problem here is that I'm getting a Variable is undefined: 'objObject' error at line 39 char 4. All is good if I remove lines 39-46 but the purpose of the code is to reformat the output from echoing the object which looks like this z:\\\\BAIBOA\\test.txt and change it into a string that looks like this z:\BAIBOA\test.txt to be used later in the code. This code has been edited from another source so maybe I'm not fully understanding what's going on. Any help would be greatly appreciated.
Option Explicit
Dim arrFolders, strComputer, objWMIService, strFolder, strCommand
Dim i, strQuery, strNewFile, arrNewFile, strFilePath, strTempFilePath
Dim colMonitoredEvents, strQueryFolder
arrFolders = Array("Z:\\\\test1", "Z:\\\\test2", "Z:\\\\test2")
strComputer = "."
'strQueryFolder = Replace(strFolder, "\", "\\\\")
Set objWMIService = GetObject("winmgmts:\\" & strComputer _
& "\root\CIMV2")
'Loop through the array of folders setting up the monitor for Each
i = 0
For Each strFolder In arrFolders
'Create the event sink
strCommand = "Set EventSink" & i & " = WScript.CreateObject" & _
"(""WbemScripting.SWbemSink"", ""SINK" & i & "_"")"
ExecuteGlobal strCommand
'Setup Notification
strQuery = "SELECT * FROM __InstanceCreationEvent WITHIN 10 " & _
"WHERE Targetinstance ISA 'CIM_DirectoryContainsFile'" & _
" and TargetInstance.GroupComponent = " & _
"'Win32_Directory.Name=""" & strFolder & """'"
strCommand = "objWMIservice.ExecNotificationQueryAsync EventSink" & _
i & ", strQuery"
ExecuteGlobal strCommand
'Create the OnObjectReady Sub
strCommand = "Sub SINK" & i & "_OnObjectReady(objObject, " & _
"objAsyncContext)" & VbCrLf & vbTab & _
"Wscript.Echo objObject.TargetInstance.PartComponent" & _
VbCrLf & "End Sub"
'WScript.Echo strCommand
ExecuteGlobal strCommand
i = i + 1
---> Line 39 Set objLatestEvent = objObject.TargetInstance.PartComponent
strNewFile = objLatestEvent.TargetInstance.PartComponent
arrNewFile = Split(strNewFile, "=")
strFilePath = arrNewFile(1)
strFilePath = Replace(strFilePath, "\\", "\")
strFilePath = Replace(strFilePath, Chr(34), "")
strFileName = Replace(strFilePath, strFolder, "")
'strTempFilePath = WScript.CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\TEMP.M4A"
Wscript.Echo strFilePath
Next
WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
Ok Ive came up with a solution for the output but now im stuck getting the script to increment correctly and will only goto the next folder if the first folder gets a file. What i need is for it to scan the array for new files not 1 by 1. :( any suggestions
Option Explicit
Dim arrFolders, strComputer, objWMIService, strFolder, strCommand
Dim i, strQuery, strNewFile, arrNewFile, strFilePath, strTempFilePath
Dim colMonitoredEvents, strQueryFolder, objObject, objLatestEvent
Dim strFileName
arrFolders = Array("Z:\\\\test1", "Z:\\\\test2", "Z:\\\\test2")
strComputer = "."
i = 0
For Each strFolder In arrFolders
'trQueryFolder = Replace(strFolder, "\", "\\\\")
strQueryFolder = strFolder
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery ("SELECT * FROM __InstanceCreationEvent WITHIN 10 " & " WHERE Targetinstance ISA 'CIM_DirectoryContainsFile' and TargetInstance.GroupComponent='Win32_Directory.Name=""" & strQueryFolder & """'")
Wscript.Echo strQueryFolder
'Do
Set objLatestEvent = colMonitoredEvents.NextEvent
strNewFile = objLatestEvent.TargetInstance.PartComponent
arrNewFile = Split(strNewFile, "=")
strFilePath = arrNewFile(1)
strFilePath = Replace(strFilePath, "\\", "\")
strFilePath = Replace(strFilePath, Chr(34), "")
strFileName = Replace(strFilePath, strFolder, "")
strTempFilePath = WScript.CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\TEMP.M4A"
' DO THE OPERATION STUFF
' ...
'Wscript.Echo objLatestEvent.TargetInstance.PartComponent
Wscript.Echo strFilePath
' If strFileName = strQueryFolder then i = i + 1 Else
'Loop
i = i + 1
Next
'WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
I have an array with a unknown number of elements.
I am trying to find out how can I insert all the array elements into the body of the e-mail that I'll send.
Is there a way I can reference all items of an array ( without knowing how many elements exist) ?
My code is below
Dim MyArray() As String
Dim Msg As Object
Dim item As Object
Set olApp = GetObject(, "Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items
olItms.Sort "Received", False 'False = Ascending = Older to newer
i = 0
For Each Msg In olItms
If Msg.Class = olMail Then
If InStr(1, Msg.Subject, "1401001LS") > 0 Then
ReDim Preserve MyArray(i)
If i = 0 Then
MyArray(i) = "From: " & Msg.Sender & vbNewLine & "Sent: " & Msg.SentOn & vbNewLine & "To: " & Msg.To & vbNewLine & "CC: " & Msg.CC & vbNewLine & "Subject: " & Msg.Subject & vbNewLine & vbNewLine & Msg.Body
End If
If i > 0 Then
MyArray(i) = "From: " & Msg.Sender & vbNewLine & "Sent: " & Msg.SentOn & vbNewLine & "To: " & Msg.To & vbNewLine & "CC: " & Msg.CC & vbNewLine & "Subject: " & Msg.Subject & vbNewLine & vbNewLine & Split(Msg.Body, "From: ")(0)
End If
i = i + 1
End If
End If
Next Msg
Unload Me
Done.Show
End Sub
you can loop through the elements in the array using the method below
Dim sContentsOfArray as string
Dim iCnt As Integer
For iCnt = 0 To UBound(MyArray) Step 1
'access the element at position iCnt and put it at the end of the string
sContentsOfArray = sContentsOfArray + MyArray (iCnt)
Next iCnt
What is wrong with this script?
Option Explicit
Dim objRootDSE, strDNSDomain, adoConnection
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim dtmStart, dtmEnd, strStart, strEnd
Dim strID, strFirst, strLast, strNTName
dtmEnd = Now()
dtmStart = DateAdd("d", -7, dtmEnd)
strStart = CStr(Year(dtmStart)) _
& Right("0" & CStr(Month(dtmStart)), 2) _
& Right("0" & CStr(Day(dtmStart)), 2) & "000000.0Z"
strEnd = CStr(Year(dtmEnd)) _
& Right("0" & CStr(Month(dtmEnd)), 2) _
& Right("0" & CStr(Day(dtmEnd)), 2) & "235959.0Z"
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory.
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.ActiveConnection = adoConnection
' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"
'For user accounts for people created in the last week
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(whenCreated>=" & strStart & ")(whenCreated<=" & strEnd & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "employeeID,sn,givenName,sAMAccountName"
' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
' Run the query.
adoRecordset.Source = strQuery
adoRecordset.Open
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values.
strID = adoRecordset.Fields("employeeID").Value
strLast = adoRecordset.Fields("sn").Value
strFirst = adoRecordset.Fields("givenName").Value
strNTName = adoRecordset.Fields("sAMAccountName").Value
Wscript.Echo """" & strID & """,""" & strLast & """,""" & strFirst
& """,""" & strNTName & """"
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
adoConnection.Close
cscript //nologo test.vbs > users.csv
returns
(53, 1) Microsoft VBScript compilation error: Expected statement
You're missing an underscore line continuation at the end of the first line of this snippet:
Wscript.Echo """" & strID & """,""" & strLast & """,""" & strFirst
& """,""" & strNTName & """"
It should look like this:
Wscript.Echo """" & strID & """,""" & strLast & """,""" & strFirst _
& """,""" & strNTName & """"