please have at look on my issue.
I try to assign a autonumber with increment plus 1 for each new record in [No] as integer.
I use following code, but it doesn`t works correctly, and records stops calculated.
Private Sub Ser_AfterUpdate()
If Ser = "O" Then
Dim MyYear, varLast
MyYear = Year(Date)
Yr = Right(MyYear, 2)
varLast = DLast("No", "NotamT")
No = varLast + 1
Types.Requery
Else
MsgBox "WRONG NOTAM SERIES"
End If
End Sub
It is not very clear, what you try to do, but it could be something like this:
Private Sub Ser_AfterUpdate()
If Ser = "O" Then
Me!Yr.Value = Year(Date) Mod 100
Me!No.Value = Nz(DMax("No", "NotamT")) + 1
Me!Types.Requery
Else
MsgBox "WRONG NOTAM SERIES"
End If
End Sub
Related
I have a form that allows the user to select the date at the top. As the user changes the date, it should change the record to reflect. If there is a record for that date already then switch to that record, but if no record for that date create a new one. The table is set to not allow duplicates on the date column. Here is the code I have on the Form_Load event and the respective subs that I call:
Private Sub Form_Load()
Me.cobYear.Value = Year(Date)
Me.cobMonth.Value = Month(Date)
DaysChange Me
Me.cobDate.Value = Day(Date)
UpdateDate Me
DoCmd.Maximize
End Sub
Sub DaysChange(objForm As Form)
Dim i As Integer
Dim DaysInMonth As Integer
Dim LeapDay As Integer
LeapDay = 0
If (Int(objForm.cobYear / 400) = (objForm.cobYear / 400)) Or ((Int(objForm.cobYear / 4) = (objForm.cobYear / 4)) And Not (Int(objForm.cobYear / 100) = (objForm.cobYear / 100))) Then
LeapDay = IIf(objForm.cobMonth = 2, 1, 0)
End If
DaysInMonth = DLookup("DaysInMonth", "tblMonths", "MonthNumber =" & objForm.cobMonth) + LeapDay
For i = 1 To DaysInMonth
objForm.cobDate.AddItem Item:=i
Next i
End Sub
Sub UpdateDate(objForm As Form)
If Not objForm.cobDate = "" And Not objForm.cobMonth = "" And Not objForm.cobYear = "" Then
objForm.tbDate.Value = DateSerial(objForm.cobYear, objForm.cobMonth, objForm.cobDate)
DayOfWeek = Weekday(objForm.tbDate.Value, 2)
'Me!subfrmDispatchSheet.Form.cobRouteID.Requery
objForm.lblDayOfWeek.Caption = WeekdayName(Weekday(objForm.tbDate.Value))
DateOfRecord = objForm.tbDate.Value
End If
End Sub
And this is the code for when a user changes the date:
Private Sub cobDate_Change()
UpdateDate Me
ChangeRecord
End Sub
Private Sub cobMonth_Change()
DaysChange Me
UpdateDate Me
ChangeRecord
End Sub
Private Sub cobYear_Change()
DaysChange Me
UpdateDate Me
ChangeRecord
End Sub
I have tried a few ways to do this.
1) I tried completely in code:
Private Sub ChangeRecord()
If DCount("ShiftDate", "tblShiftRecap", "ShiftDate =" & Me.tbDate.Value) = 0 Then
Else
Me.tbShiftID.Value = DLookup("ShiftID", "tblShiftRecap", "ShiftDate =" & Me.tbDate.Value)
End If
Me.Requery
End Sub
How can I do this on a single form? I know how to do it if I add a subform but not if all the fields are in my single form.
Unfortunately, this tries to add a new record when I load up the form.
2) I tried doing it in the query also
SELECT tblShiftRecap.ShiftID, tblShiftRecap.MQFStartTime
FROM tblShiftRecap
WHERE (((tblShiftRecap.ShiftDate)=GetDateOfRecord()));
and the functiont that the SQL calls:
Public Function GetDateOfRecord()
GetDateOfRecord = DateOfRecord
End Function
If I get your question correctly, you want to navigate to a certain record in the current form based on a condition
To navigate the form, the easiest way is to open up a recordset clone, use .FindFirst, and then change the current record on the form to the found record:
Dim rs As Recordset
Set rs = Me.RecordsetClone 'Load form records into recordset clone
rs.FindFirst "ShiftDate = " & Format(DateOfRecord, "\#yyyy-mm-dd\#") 'Navigate to date
If Not rs.NoMatch 'If there's a matching record
Me.Bookmark = rs.Bookmark 'Navigate to it
End If
I am currently collecting data from my PLC with easyModbus (using Visual Basic) every 1 second with a timer and later I want to insert data to a database. My goal is to only refresh data in my program when a value changes inside of the PLC.
For example: I have 4 LEDs, 1-green 2-yellow 3-red 4-blue, and I have a timer which measures the elapsed time from when the red light comes on to when it turns of.
I want to log the time data to a database....when the error happened...when the error if fixed. But with my 1 sec refresh it is writing my data every 1 sec and I need it to only write the data when it changed...and I also don't want to ask the PLC every single second because I don't need to.
Public Sub Refresh_btn_Click() Handles Refresh_btn.Click
Dim ComError = 0 'Set comm error flag to 0
Dim Ipaddress As String
Ipaddress = "127.0.0.1"
Dim Portaddress As String
Portaddress = "502"
Dim ModbusClient As EasyModbus.ModbusClient = New EasyModbus.ModbusClient(Ipaddress, Portaddress) 'Ip address and port Text box = Ip on form
Try
ModbusClient.Connect() 'Connect to PLC
Catch ex As Exception 'What to do when error occurs
Status_lbl.BackColor = Color.Red
Status_lbl.ForeColor = Color.White
Status_lbl.Text = "Error!"
ComError = 1 'Set comm error flag to 1
End Try
If ComError = 0 Then
Status_lbl.BackColor = Color.Green
Status_lbl.ForeColor = Color.White
Status_lbl.Text = "No Error!"
'First line Andon
Dim Registers As Integer()
Registers = ModbusClient.ReadHoldingRegisters(0, 10)
'Indexing Registers starting with null
If Registers(0) = 0 Then
GreenSIGN.BackColor = Color.LightGray
YellowSIGN.BackColor = Color.LightGray
RedSIGN.BackColor = Color.LightGray
BlueSIGN.BackColor = Color.LightGray
End If
If Registers(0) = 1 Then
GreenSIGN.BackColor = Color.Green
Else
GreenSIGN.BackColor = Color.LightGray
End If
If Registers(0) = 2 Then
YellowSIGN.BackColor = Color.Yellow
Else
YellowSIGN.BackColor = Color.LightGray
End If
If Registers(0) = 3 Then
RedSIGN.BackColor = Color.Red
Else
RedSIGN.BackColor = Color.LightGray
End If
If Registers(0) = 4 Then
BlueSIGN.BackColor = Color.Blue
Else
BlueSIGN.BackColor = Color.LightGray
End If
End If
ModbusClient.Disconnect()
'Timer for downtime Static Start-Stop
Static start_time As DateTime = Now
Static stop_time As DateTime = Now
Static start_time2 As DateTime = Now
Static stop_time2 As DateTime = Now
Dim elapsed_time As TimeSpan
'Only Red Andon
'If for Red andon For Line XXX
If RedSIGN.BackColor = Color.Red Then
stop_time = Now
elapsed_time = stop_time.Subtract(start_time)
lbl_elapsed_red.Text = elapsed_time.ToString("hh\:mm\:ss")
Else
lbl_elapsed_red.Text = "Ok"
start_time = Now
End If
'Only Blue Andon
'If for Blue andon For Line XXX
If BlueSIGN.BackColor = Color.Blue Then
stop_time2 = Now
elapsed_time = stop_time2.Subtract(start_time2)
lbl_elapsed_blue.Text = elapsed_time.ToString("hh\:mm\:ss")
Else
lbl_elapsed_blue.Text = "Ok"
start_time2 = Now
End If
'Connectin MySQL
'Try
' Dim SQL As String 'SQL Command String
' Dim objCmd As New MySqlCommand 'Command
' 'Connection String to the SQL Database
' Dim Con = New MySqlConnection("server=127.0.0.1;user id=root;database=andon")
' 'SQL Statement - All values must be set for the table
' SQL = "INSERT INTO test_andon VALUES ('" & Now.ToString("yyyy/MM/dd") & "', '" & Now.ToString("HH:mm:ss") & "','" & "#dummy" & "', '" & Now.ToString("start_time2") & "', '" & "#dummy" & "', '" & "#dummy" & "')"
' Con.Open() 'Open the database connection
' objCmd = New MySqlCommand(SQL, Con) 'Set the command
' objCmd.ExecuteNonQuery() 'Execute the SQL command
' Con.Close() 'Close the database connection
'Catch ex As Exception 'What to do when an error occurs
' Status_lbl.BackColor = Color.Red
' Status_lbl.ForeColor = Color.White
' Status_lbl.Text = "Database Error Blue vége!"
'End Try
End Sub
'Timer reping
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Timer1.Interval = 100
Timer1.Enabled = True
Call Sub() Refresh_btn_Click()
End Sub
You can store the state of the red light and check if the new value is different from the old value. If it is, then write to the database and update the old value, otherwise do nothing.
For example, pretend that the incoming value related to the red light is r(t):
Imports System.Timers
Module Module1
Dim t As Integer = 0
Dim r() As Integer = {0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1}
Dim prevValue As Integer = Integer.MinValue
Sub tock(sender As Object, e As ElapsedEventArgs)
Dim val = r(t)
Console.Write(val.ToString() & " ")
If val <> prevValue Then
Console.WriteLine("Write to database.")
prevValue = val
Else
Console.WriteLine("Do nothing.")
End If
t = (t + 1) Mod r.Length
End Sub
Sub Main()
Dim tim As New Timers.Timer With {.Interval = 1000, .AutoReset = True}
AddHandler tim.Elapsed, AddressOf tock
tim.Start()
Console.WriteLine("Tocking... press enter to quit.")
Console.ReadLine()
tim.Stop()
tim.Dispose()
End Sub
End Module
Outputs:
Tocking... press enter to quit.
0 Write to database.
1 Write to database.
1 Do nothing.
1 Do nothing.
1 Do nothing.
0 Write to database.
0 Do nothing.
0 Do nothing.
0 Do nothing.
0 Do nothing.
1 Write to database.
0 Write to database.
1 Write to database.
1 Do nothing.
[Carries on until enter is pressed.]
Notice that the first value makes a write-to-database because prevValue was initialised to a value which r(t) will never have. After that, write-to-database only happens when r(t) <> r(t-1).
I have been looking for some code that creates a calendar year and will take data from a table and place it in the corresponding date on the calendar. I found some code online (from an older version of access) that pretty much fit the bill, with some modifications it does exactly what I need it to do. Originally, the code pulled data from one table and it was set up to run on the current year. I use two queries, qr_SafetyCal and qr_SafetyCal2, to refine data from the one table. The first query prioritizes the data and eliminates multiple events on any given day. The second query uses the results from the first and specifies the year in the query criteria.
The code works flawlessly as long as I set the year criteria in the qr_SafetyCal2 and specify the first day, ex. 1/1/2017 (datStart) in the underlying code of the calendar year I want displayed.
After getting the code squared away I created a pop up form the user to select the year for the report but when I run the report I get the following error, Runtime Error 3061 too few parameters expected 1.
From what I have been able to research, I believe I changed the dynamic of the code when I referenced the form in the query criteria that the DAO Recordset Used.
As I understand it, the criteria in the query is not passed to the rs and therefore needs to be declared in the code. What I can't figure out is how to declare the variables in the code through reference to the form. I hope that makes some sense to somebody, long explanation but hard to describe something you don't understand.
Below is all the code and you will see some things I've rem'd out that I have tried but did not work. Any help would be greatly appreciated. I apologize ahead of time if the code is not formatted correctly.
Option Compare Database
Option Explicit
Private m_strCTLLabel As String
Private m_strCTLLabelHeader As String
Private colCalendarDates As Collection
Function getCalendarData() As Boolean
Dim rs As DAO.Recordset
Dim strDate As String
Dim strCode As String
Dim i As Integer
'Dim qdf As DAO.QueryDef
'Set qdf = CurrentDb.QueryDef("qr_SafetyCal2")
'qdf.Parameters("[Forms]![fr_SafetyCal]![cboYear]") = [Forms]![fr_SafetyCal]![cboYear]
'Set rs = qdf.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set rs = CurrentDb.OpenRecordset("qr_SafetyCal2", dbOpenDynaset)
Set colCalendarDates = New Collection
With rs
If (Not .BOF) Or (Not .EOF) Then
.MoveLast
.MoveFirst
End If
If .RecordCount > 0 Then
For i = 1 To .RecordCount
strDate = .Fields("Date")
strCode = .Fields("ShortName")
colCalendarDates.Add strCode, strDate
.MoveNext
Next i
End If
.Close
End With
'Return of dates and data collection form qr_SafetyCal2
Set rs = Nothing
End Function
Public Sub loadReportYearCalendar(theReport As Report)
Dim i As Integer
Dim datStart As Date
Dim rptControl As Report
m_strCTLLabel = "labelCELL"
m_strCTLLabelHeader = "labelDAY"
'Load calendar data for the specified year into the collection
Call getCalendarData
With theReport
'Get the first month of the specified year
datStart = "1/1/2017" '"1/1/" & Year(Date), "1/1/" & Forms!
[fr_SafetyCal]![cboYear], Forms![fr_SafetyCal]![txtCalYear]
'Add the specified year to the report's label
.Controls("labelCalendarHeaderLine2").Caption = Year(datStart) & "
iCalendar"
For i = 1 To 12
'Set pointer to subreport control hosting the mini-calendar
Set rptControl = .Controls("childCalendarMonth" & i).Report
'Run procedure to populate control with it's respective year
Call loadReportCalendar(rptControl, datStart)
'Reset and obtain first day of the following month
datStart = DateAdd("m", 1, datStart)
Next i
End With
'Clean up
Set colCalendarDates = Nothing
Set rptControl = Nothing
End Sub
Public Sub loadReportCalendar(theReport As Report, Optional StartDate As
Date, Optional theHeaderColor As Variant)
Dim i As Integer
Dim intCalDay As Integer
Dim datStartDate As Date
Dim intWeekDay As Integer
datStartDate = StartDate
intWeekDay = Weekday(datStartDate)
With theReport
.Controls("labelMONTH").Caption = Format(StartDate, "mmmm")
'Change the day label's backcolor if necessary
If Not (IsMissing(theHeaderColor)) Then
For i = 1 To 7
.Controls("labelDayHeader" & i).BackColor = theHeaderColor
Next
End If
For i = 1 To 42
With .Controls(m_strCTLLabel & i)
If (i >= intWeekDay) And (Month(StartDate) =
Month(datStartDate)) Then
If (datStartDate = Date) Then
.BackColor = 14277081
End If
On Error Resume Next
Dim strCaption As String
Dim strKey As String
strKey = datStartDate
strCaption = ""
strCaption = colCalendarDates.Item(strKey)
colCalendarDates.Remove strKey
'Set back color to grean on days in the past that have
no corresponding event
If (datStartDate < Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
.BackColor = vbGreen
.ForeColor = vbWhite
.Heavy = True
'Do not set a back color for days in the future
ElseIf (datStartDate > Date) And (strCaption = vbNullString) Then
.Caption = Day(datStartDate)
.Bold = False
'Set the corresponding labels and formats for each specified event
Else
.Caption = strCaption
.Bold = True
Select Case strCaption
Case "FA"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
Case "FAM"
.BackColor = vbYellow
.ForeColor = 0
.LeftMargin = 0
.TextAlign = 2
.Heavy = True
Case "LTA"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
Case "MED"
.BackColor = vbRed
.ForeColor = vbWhite
.LeftMargin = 0
.TextAlign = 2
End Select
End If
datStartDate = DateAdd("d", 1, datStartDate)
Else
.Caption = ""
End If
End With
Next i
End With
End Sub
Here is SQL for the two queries, the first is qr_SafetyCal and the second is qr_SafetyCal2:
SELECT tb_CaseLog.Date, Max(tb_Treatment.Priority) AS MaxOfPriority,
Count(tb_Treatment.TreatmentID) AS CountOfTreatmentID
FROM tb_Treatment INNER JOIN tb_CaseLog ON tb_Treatment.TreatmentID =
tb_CaseLog.Treatment
GROUP BY tb_CaseLog.Date;
SELECT qr_SafetyCal.Date, tb_Treatment.ShortName,
qr_SafetyCal.CountOfTreatmentID AS [Count], Year([Date]) AS CalYear
FROM qr_SafetyCal INNER JOIN tb_Treatment ON qr_SafetyCal.MaxOfPriority =
tb_Treatment.Priority;
No need to reference QueryDef.
Open the recordset object with filtered dataset by referencing the combobox like:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
or if the code is behind the form:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE CalYear=" & Me.[cboYear], dbOpenDynaset)
Both examples assume the field is a number type.
If there is no field in query with the year value, it can be extracted from date value field in the VBA construct:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qr_SafetyCal2 WHERE Year([YourFieldnameHere])=" & [Forms]![fr_SafetyCal]![cboYear], dbOpenDynaset)
Code for setting datStart variable:
'Get the first month of the specified year
datStart = "1/1/" & Forms![fr_SafetyCal].[cboYear]
I have 3 columns with titles Used and Add and Total.
Condition are;
Used: allows user to input any positive value but stores it in the table filed as a negative value.
Add: allows user to input positive values and stores it in the table field as a positive.
Total: Stores the sum of the fields associated with Used and Add.
This is what I have so far. The Total filed does not work as expected. Any idea?
'Add to database a new value -------------------------
Private Sub Add_AfterUpdate()
If IsNull(Add.Value) Then
Add.Value = 0
ElseIf Add.Value < 0 Then
Add1.Value = -Add.Value
ElseIf Add.Value > 0 Then
Add.Value = Add
End If
Total_AfterUpdate 'To update the Total in textbox--------------
Add_Enter 'To show 0 in the textbox--------------
End Sub
'Substract from databae field a new value from already existing value-------
Private Sub Used_AfterUpdate()
Used.Value = Used
If IsNull(Used.Value) Then
Used.Value = 0
ElseIf Used.Value < 0 Then
Used.Value = -Used.Value
ElseIf Used.Value > 0 Then
Used.Value = Used
End If
Total_AfterUpdate 'To update the Total in textbox--------------
Add_Enter 'To show 0 in the textbox--------------
End Sub
'Total the results based on changes made through the Used textbox or the Add texbox
Private Sub Total_AfterUpdate()
Dim TotalAdd As Double
Dim TotalUsed As Double
TotalAdd = Total.Value + Add
Total = TotalAdd
TotalUsed = Total.Value - Used
Total = TotalUsed
End Sub
Unless I've misunderstood, try something like this:
Private Sub Used_AfterUpdate()
If IsNull(Used) Then
Used = 0
ElseIf Used > 0 Then
Used = -Used
End If
Total_AfterUpdate
End Sub
Private Sub Add_AfterUpdate()
If IsNull(Add) Then
Add = 0
ElseIf Add < 0 Then
Add = -Add
End If
Total_AfterUpdate
End Sub
Private Sub Total_AfterUpdate()
Total = Used + Add
End Sub
EDIT: Alternatively, this may be written:
Private Sub Used_AfterUpdate()
Used = -Abs(Nz(Used, 0))
Total_AfterUpdate
End Sub
Private Sub Add_AfterUpdate()
Add = Abs(Nz(Add, 0))
Total_AfterUpdate
End Sub
Private Sub Total_AfterUpdate()
Total = Used + Add
End Sub
In our code, we have a few Excel objects and a few subs and functions.
We edited a few things and now, for some reason, our objects aren't working inside the sub, the give a "Object Required" error.
We don't know what to do anymore, so any help would be greatly appreciated!
Note: We added the entire code in case there would be questions about declarations and that...
Sub:
Sub birthday (formatDate, i, intRow)
'Take date from database, separate it to days & months
Dim month, day, name
eventDate = Split(formatDate,"/")
month = eventDate(0)
day = eventDate(1)
'Get name of event out of database (one column to the right, from date of event)
name = "netch"
'Get value of row which is used to write events in the specific month
Dim k, row, c
k = 1
wscript.echo objXLCal.Cells(k, 2).Value
Do Until objXLCal.Cells(k, 2).Value = monthRet(month)
k = k + 1
Loop
'k will be used to find the day column, while row is where the events of that months are written
row = k + 3
c = 1
'Get value of column
Do Until objXLCal.Cells(k,c).Value = eval(day)
c = c + 1
Loop
'Insert name of event into place
If Asc(name) = 63 Then
objXLCal.Cells(row,c).Value = StrReverse(name)
Else
objXLCal.Cells(row,c).Value = name
End If
End Sub
Rest of code:
main("C:\Users\liatte\Desktop\hotFolder\Input")
Function main(argFilePath)
Dim templatePath
'-----------------------------------------------------------------------------
'Path to calendar template
templatePath = "C:\Users\liatte\Desktop\Aviv Omer Neta\Birthdays\Calendar1.xlsx"
'-----------------------------------------------------------------------------
'creates the msxml object
'Set xmlDoc = CreateObject("Msxml2.DOMDocument.6.0")
'Dim retVal
'load the xml data of the script
'retVal=xmlDoc.load(argFilePath)
Dim fso, folder, sFolder, inputFolder, xmlDataPath, curNode
'get input folder
'Set curNode=xmlDoc.selectSingleNode("//ScriptXmlData/inputFilePath")
'inputFolder=CSTR(curNode.text)
'location of input folder
'sFolder=inputFolder
sFolder=argFilePath
'creating file getting object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sFolder)
'loop that runs on files in input - RUNS JUST ONCE
'For each folderIdx In folder.files
'Creating object for user excel
Set objXLBirth = CreateObject("Excel.Application")
Set objWorkbookBirth = objXLBirth.Workbooks.Open("C:\Users\liatte\Desktop\hotFolder\Input\Birthdays.xlsx")
'Creating object for calendar template excel
Set objXLCal = CreateObject("Excel.Application")
objXLCal.DisplayAlerts = false
Dim picStr, srcMonth, k, i, intRow, formatDate, txtStr
'Beginning reading from line 2, skipping header
intRow = 2
'loop for each person in user excel
Do Until objXLBirth.Cells(intRow,1).Value = ""
i=2
'Opening the template as new in each round of loop
Set objWorkbookCal = objXLCal.Workbooks.Open(templatePath)
'Cover pic
If Not objXLBirth.Cells(intRow, i).Value = "" Then
objXLCal.Cells(2, 49).Value = objXLBirth.Cells(intRow, i).Value
End If
'Month pic inserter
For i=3 To 14
If Not objXLBirth.Cells(intRow,i).Value = "" Then
picStr = objXLBirth.Cells(1,i).Value
srcMonth = monthRet(Mid(picStr,4))
k=1
Do Until objXLCal.Cells(k, 2).Value = srcMonth
k=k+1
Loop
objXLCal.Cells(k, 47).Value = objXLBirth.Cells(intRow,i).Value
End If
Next
i=15
'Cover text inserter
If Not objXLBirth.Cells(intRow, i).Value = "" Then
objXLCal.Cells(2, 50).Value = objXLBirth.Cells(intRow, i).Value
End If
'Month text inserter
For i = 16 To 27
If Not objXLBirth.Cells(intRow,i).Value = "" Then
txtStr = objXLBirth.Cells(1,i).Value
srcMonth = monthRet(Mid(txtStr,5))
k=1
Do Until objXLCal.Cells(k, 2).Value = srcMonth
k=k+1
Loop
If Asc(objXLBirth.Cells(intRow, i).Value)=63 Then
objXLCal.Cells(k, 48).Value = StrReverse(objXLBirth.Cells(intRow, i).Value)
Else
objXLCal.Cells(k, 48).Value = objXLBirth.Cells(intRow, i).Value
End If
End If
Next
i=28
'Birthday inserter
Do Until objXLBirth.Cells(intRow,i).Value = ""
formatdate=FormatDateTime(objXLBirth.Cells(intRow,i),2)
Call birthday (formatdate,i,intRow)
i=i+2
Loop
'saving changed calendar
objXLCal.ActiveWorkBook.SaveAs "C:\Users\liatte\Desktop\Aviv Omer Neta\Birthdays\Calendar_" & objXLBirth.Cells(intRow, 1).Value & ".txt", 42
intRow = intRow+1
Loop
'moving file to Success
'fso.MoveFile inputFolder, "C:\Users\liatte\Desktop\Success\"
'Next
objXLBirth.Quit
objXLCal.Quit
End Function
Another function:
Function monthRet(month)
Select Case month
Case "1"
monthRet="January"
Case "2"
monthRet="February"
Case "3"
monthRet="March"
Case "4"
monthRet="April"
Case "5"
monthRet="May"
Case "6"
monthRet="June"
Case "7"
monthRet="July"
Case "8"
monthRet="August"
Case "9"
monthRet="September"
Case "10"
monthRet="October"
Case "11"
monthRet="November"
Case "12"
monthRet="December"
End Select
End Function
Thank you very much!
Given a code layout like:
Sub birthday (formatDate, i, intRow)
...
wscript.echo objXLCal.Cells(k, 2).Value
...
End Sub
Function main(argFilePath)
...
Set objXLCal = CreateObject("Excel.Application")
...
End Function
main "C:\Users\liatte\Desktop\hotFolder\Input"
an "Object required" error for the WScript.Echo line is to be expected (the local variable objXLCal initialized in main isn't the same as the (therefore) uninitialized local variable objXLCal in birthday).
The correct solution would be to start with "Option Explicit" and follow the principles of decent procedural programming in VBScript, but the disgusting hack of Diming variables like objXLCal at the top/global level won't lower the quality of the published code.