PDA

View Full Version : need macro for auto year workbook with auto months and dates



thickwall
09-07-2019, 12:23 PM
I need help in Macro for date and time in rows of workbook

Workbook contain 12 sheets Having Names Of Months
like Sheet 1 = January
Sheet 2 = February
Sheet 12 = December

every sheet contains its date like January have 31 days that means Row will be 31 and so on

Auto Generation of Workbook of relative Year like 2019 is the workbook then auto generation of months in the work book sheet and auto generation of Days in relative month sheets
after this when i fetch the data thru vba it should validate the system date and time and nd copy the data according to the system date and time the data will be fetch and placed in its position like if i have schedule task to fetch a data everyday at 7 am then rows of sheet containing date must concatenate with running time schedule task

example if data called on 1st september 2019 then work book of name with 2019 will open and then sheet with name of Sept should open and then in row with date 1 where data will be placed and having date 1 in cell the time will concatenate with 1 showing calling date and time


Faconclientssp3 macro is as follows



Dim server As Object
'Sub Button1_Click()
Private Sub Workbook_Open()
'Application.Wait Now() + TimeValue("00:00:10")
'For a = 1 To 10
'MsgBox (a)
'Next
'Sub Button1_Click()
Set server = CreateObject("faconsvr.faconserver")
server.openproject ("C:\Documents and Settings\LMS\My Documents\SSP3\FaconClientSSP3.fcs")
server.Connect
Application.Wait Now() + TimeValue("00:00:03")
'timer1.enable = True
Worksheets("Sheet1").Range("g16") = server.getitem("channel0.station0.group_kw", "DR1100")
Worksheets("Sheet1").Range("g17") = server.getitem("channel0.station0.group_kw", "DR1102")
Worksheets("Sheet1").Range("g18") = server.getitem("channel0.station0.group_kw", "DR1104")
Worksheets("Sheet1").Range("g19") = server.getitem("channel0.station0.group_kw", "DR1106")
Worksheets("Sheet1").Range("g20") = server.getitem("channel0.station0.group_kw", "DR1108")
Worksheets("Sheet1").Range("g21") = server.getitem("channel0.station0.group_kw", "DR1110")
Worksheets("Sheet1").Range("g22") = server.getitem("channel0.station0.group_kw", "DR1112")
Worksheets("Sheet1").Range("g23") = server.getitem("channel0.station0.group_kw", "DR1114")
Worksheets("Sheet1").Range("g24") = server.getitem("channel0.station0.group_kw", "DR1116")
Worksheets("Sheet1").Range("g25") = server.getitem("channel0.station0.group_kw", "DR1118")
Worksheets("Sheet1").Range("g26") = server.getitem("channel0.station0.group_kw", "DR1120")
Worksheets("Sheet1").Range("g27") = server.getitem("channel0.station0.group_kw", "DR1122")
Worksheets("Sheet1").Range("g28") = server.getitem("channel0.station0.group_kw", "DR1124")
Worksheets("Sheet1").Range("g29") = server.getitem("channel0.station0.group_kw", "DR1126")
Worksheets("Sheet1").Range("g30") = server.getitem("channel0.station0.group_kw", "DR1128")
Worksheets("Sheet1").Range("g31") = server.getitem("channel0.station0.group_kw", "DR1130")
Worksheets("Sheet1").Range("g32") = server.getitem("channel0.station0.group_kw", "DR1132")
Worksheets("Sheet1").Range("g33") = server.getitem("channel0.station0.group_kw", "DR1134")
Worksheets("Sheet1").Range("g34") = server.getitem("channel0.station0.group_kw", "DR1136")
Worksheets("Sheet1").Range("g35") = server.getitem("channel0.station0.group_kw", "DR1138")
Worksheets("Sheet1").Range("g36") = server.getitem("channel0.station0.group_kw", "DR1140")
Worksheets("Sheet1").Range("g37") = server.getitem("channel0.station0.group_kw", "DR1142")
Worksheets("Sheet1").Range("g38") = server.getitem("channel0.station0.group_kw", "DR1144")
Worksheets("Sheet1").Range("g39") = server.getitem("channel0.station0.group_kw", "DR1146")
Worksheets("Sheet1").Range("g40") = server.getitem("channel0.station0.group_kwh", "DR2200")
Worksheets("Sheet1").Range("g41") = server.getitem("channel0.station0.group_kwh", "DR2202")
Worksheets("Sheet1").Range("g42") = server.getitem("channel0.station0.group_kwh", "DR2204")
Worksheets("Sheet1").Range("g43") = server.getitem("channel0.station0.group_kwh", "DR2206")
Worksheets("Sheet1").Range("g44") = server.getitem("channel0.station0.group_kwh", "DR2208")
Worksheets("Sheet1").Range("g45") = server.getitem("channel0.station0.group_kwh", "DR2210")
Worksheets("Sheet1").Range("g46") = server.getitem("channel0.station0.group_kwh", "DR2212")
Worksheets("Sheet1").Range("g47") = server.getitem("channel0.station0.group_kwh", "DR2214")
Worksheets("Sheet1").Range("g48") = server.getitem("channel0.station0.group_kwh", "DR2216")
Worksheets("Sheet1").Range("g49") = server.getitem("channel0.station0.group_kwh", "DR2218")
Worksheets("Sheet1").Range("g50") = server.getitem("channel0.station0.group_kwh", "DR2220")
Worksheets("Sheet1").Range("g51") = server.getitem("channel0.station0.group_kwh", "DR2222")
Worksheets("Sheet1").Range("g52") = server.getitem("channel0.station0.group_kwh", "DR2224")
Worksheets("Sheet1").Range("g53") = server.getitem("channel0.station0.group_kwh", "DR2226")
Worksheets("Sheet1").Range("g54") = server.getitem("channel0.station0.group_kwh", "DR2228")
Worksheets("Sheet1").Range("g55") = server.getitem("channel0.station0.group_kwh", "DR2230")
Worksheets("Sheet1").Range("g56") = server.getitem("channel0.station0.group_kwh", "DR2232")
Worksheets("Sheet1").Range("g57") = server.getitem("channel0.station0.group_kwh", "DR2234")
Worksheets("Sheet1").Range("g58") = server.getitem("channel0.station0.group_kwh", "DR2236")
Worksheets("Sheet1").Range("g59") = server.getitem("channel0.station0.group_kwh", "DR2238")
Worksheets("Sheet1").Range("g60") = server.getitem("channel0.station0.group_kwh", "DR2240")
Worksheets("Sheet1").Range("g61") = server.getitem("channel0.station0.group_kwh", "DR2242")
Worksheets("Sheet1").Range("g62") = server.getitem("channel0.station0.group_kwh", "DR2244")
Worksheets("Sheet1").Range("g63") = server.getitem("channel0.station0.group_kwh", "DR2246")
'close filename "C:\Documents and Settings\LMS\My Documents\My Music\closefacon.bat"
'Application.Quit ("C:\Documents and Settings\LMS\My Documents\My Music\facon clients.fcs")
'server.Application.Quit ("C:\Documents and Settings\LMS\My Documents\My Music\facon clients.fcs")
With Workbooks("FaconClientSSP3.xls").Worksheets("Sheet1").Range("G16:G63").Copy
'Range("G25").Select
'Selection.Copy
'Range("H25").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
Workbooks.Open filename:= _
"C:\Documents and Settings\LMS\My Documents\SSP3\SSP3FDRDATA2016.xls"
Select Case Month(Now())
Case 1
s = "JANUARY"
Case 2
s = "FABUARY"
Case 3
s = "MARCH"
Case 4
s = "APRIL"
Case 5
s = "MAY"
Case 6
s = "JUNE"
Case 7
s = "JULY"
Case 8
s = "AUGUST"
Case 9
s = "SEPTEMBER"
Case 10
s = "OCTOBER"
Case 11
s = "NOVEMBER"
Case 12
s = "DECEMBER"
End Select
'Range("H25").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
Select Case Day(Now())
Case 1
Excel.Sheets(s).Select
Range("G16:G63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G14") = Time()
Case 2
Excel.Sheets(s).Select
Range("H16:H63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H14") = Time()
Case 3
Excel.Sheets(s).Select
Range("I16:I63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I14") = Time()
Case 4
Excel.Sheets(s).Select
Range("J16:J63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J14") = Time()
Case 5
Excel.Sheets(s).Select
Range("K16:K63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K14") = Time()
Case 6
Excel.Sheets(s).Select
Range("L16:L63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L14") = Time()
Case 7
Excel.Sheets(s).Select
Range("M16:M63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M14") = Time()
Case 8
Excel.Sheets(s).Select
Range("N16:N63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N14") = Time()
Case 9
Excel.Sheets(s).Select
Range("O16:O63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("O14") = Time()
Case 10
Excel.Sheets(s).Select
Range("P16:P63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P14") = Time()
Case 11
Excel.Sheets(s).Select
Range("Q16:Q63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q14") = Time()
Case 12
Excel.Sheets(s).Select
Range("R16:R63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R14") = Time()
Case 13
Excel.Sheets(s).Select
Range("S16:S29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("S14") = Time()
Case 14
Excel.Sheets(s).Select
Range("T16:T63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("T14") = Time()
Case 15
Excel.Sheets(s).Select
Range("U16:U63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U14") = Time()
Case 16
Excel.Sheets(s).Select
Range("V16:V63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("V14") = Time()
Case 17
Excel.Sheets(s).Select
Range("W16:W63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W14") = Time()
Case 18
Excel.Sheets(s).Select
Range("X16:X63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("X14") = Time()
Case 19
Excel.Sheets(s).Select
Range("Y16:Y63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Y14") = Time()
Case 20
Excel.Sheets(s).Select
Range("Z16:Z63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Z14") = Time()
Case 21
Excel.Sheets(s).Select
Range("AA16:AA63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AA14") = Time()
Case 22
Excel.Sheets(s).Select
Range("AB16:AB63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AB14") = Time()
Case 23
Excel.Sheets(s).Select
Range("AC16:AC63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AC14") = Time()
Case 24
Excel.Sheets(s).Select
Range("AD16:AD63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AD14") = Time()
Case 25
Excel.Sheets(s).Select
Range("AE16:AE63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AE14") = Time()
Case 26
Excel.Sheets(s).Select
Range("AF16:AF63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF14") = Time()
Case 27
Excel.Sheets(s).Select
Range("AG16:AG63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AG14") = Time()
Case 28
Excel.Sheets(s).Select
Range("AH16:AH63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AH14") = Time()
Case 29
Excel.Sheets(s).Select
Range("AI16:AI63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AI14") = Time()
Case 30
Excel.Sheets(s).Select
Range("AJ16:AJ63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AJ14") = Time()
Case 31
Excel.Sheets(s).Select
Range("AK16:AK63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AK14") = Time()
End Select
'''''''''''''''''''''''''''MOLDING LMS TEXT FILE CREATION''''''''''''''''''''
Dim sName As String
Dim rng_1 As Range, cell_1 As Range
Dim rng_2 As Range, cell_2 As Range
'sName = ActiveSheet.Name
'sName = Application.GetSaveFilename( _
InitialFileName:=sName & ".txt", _
FileFilter:="Text Files (*.txt),*.txt")
'If sName = "" Then Exit Sub
Open "C:\Documents and Settings\LMS\My Documents\NA_Folder\MOLDLmsText.txt" For Output As #1
Set rng_1 = Range(Range("C55"), _
Cells(Rows.Count, 3).End(xlUp))
For Each cell_1 In rng_1
Print #1, cell_1.Offset(0, 0).Text
Print #1, cell_1.Offset(0, 4).Text
Print #1,
Next
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
'Call MyOPCServer.Disconnect
'Set MyOPCServer = Nothing
ActiveWorkbook.Save
'ActiveWorkbook.Closed SaveChanges = 1
Application.Quit
End Sub

Private Sub closeprogram()
myAppid = Shell("C:\Program Files\Fatek\FaconSvr\FaconSvr.exe", 1)
SendKeys "%{F4}", True
End Sub

it runs in schedule task where data is transfered in a file (image is attached) ...ssp3 decr run when image file have data to transfer from this file into another daily energy consumption sheet...i want it in one go which ...file is of 2007 but ill use 2016 excel kindly help

Leith Ross
09-07-2019, 05:16 PM
Hello thickwall,

Welcome to the forum!

Your VBA Project in the workbook "FaconClientSSP3.xls" is password protected. Please post the password or another copy of the workbook with the VBA Project unlocked.

Leith Ross
09-07-2019, 06:10 PM
Hello thickwall,

The code you posted for Button1 can be replaced with this code...


Sub Private Workbook_Open()
Dim Col As Long
Dim Data As Variant
Dim Row As Long
Dim Text As String
Dim Item As Variant
Dim Wks As Worksheet
Dim Wkb1 As Workbook
Dim Wkb2 As Workbook

Set server = CreateObject("faconsvr.faconserver")
server.openproject ("C:\Documents and Settings\LMS\My Documents\SSP3\FaconClientSSP3.fcs")
server.Connect

Application.Wait Now() + TimeValue("00:00:03")

For Row = 16 To 63
If Row < 40 Then
Item = "DR11" & Format(((Row - 16) * 2), "00")
Else
Item = "DR22" & Format(((Row - 16) * 2), "00")
End If

Worksheets("Sheet1").Cells(Row, "G") = server.getitem("channel0.station0.group_kw", Item)
Next Row

Set Wkb1 = Workbooks("FaconClientSSP3.xls")
Set Wks = Wkb1.Worksheets("sheet1")

Data = Wks.Range("G16:G63").Value

Wks.Range("H25").Resize(UBound(Data), 1).Value = Data


Set Wkb2 = Workbooks.Open(Filename:="C:\Documents and Settings\LMS\My Documents\SSP3\SSP3FDRDATA2016.xls")
Set Wks = Wkb2.Worksheets(UCase(Format(Now(), "mmmm")))

Col = Day(Now()) + 6

Wks.Range(Wks.Cells(16, Col), Wks.Cells(63, Col)).Value = Data
Wks.Cells(14, Col) = Time()


Open "C:\Documents and Settings\LMS\My Documents\NA_Folder\MOLDLmsText.txt" For Output As #1
For Each cell In Wks.Range(Wks.Cells(55, "C"), Wks.Cells(Rows.Count, "C").End(xlUp))
Text = cell.Text & vbCrLf & cell.Offset(0, 4).Text & vbCrLf & vbCrLf
Print #1, Text
Next cell
Close #1


Wkb2.Close SaveChanges:=True
Wkb1.Close SaveChanges:=True

Application.Quit


End Sub

Leith Ross
09-07-2019, 10:56 PM
Duplicate Post