new_vba

imus_2015_08_10.vbs

Sub Go()
        Dim objMyConn As ADODB.Connection
        Dim objMyCmd As ADODB.Command
        Dim objMyRecordset As ADODB.Recordset

        Set objMyConn = New ADODB.Connection
        Set objMyCmd = New ADODB.Command
        Set objMyRecordset = New ADODB.Recordset
        
        Set objMyCmd1 = New ADODB.Command
        Set objMyRecordset1 = New ADODB.Recordset
        
        Set objMyCmd2 = New ADODB.Command
        Set objMyRecordset2 = New ADODB.Recordset
        
        Set objMyCmd3 = New ADODB.Command
        Set objMyRecordset3 = New ADODB.Recordset

        objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.54.203;Initial Catalog=ascug;User ID=TEST;Password=test;"
        objMyConn.Open
        Set objMyCmd.ActiveConnection = objMyConn
        Set objMyCmd1.ActiveConnection = objMyConn
        Set objMyCmd2.ActiveConnection = objMyConn
        Set objMyCmd3.ActiveConnection = objMyConn
        
        
        
        
        query_text_old = "SELECT channel_id, contract_id, corr_time, ext_system_id, exps_nu FROM add_arc_exps_d WHERE corr_time='" & date_old & "' ORDER BY channel_id"
        old = query_master(objMyRecordset2, objMyCmd2, query_text_old)

        query_text = "SELECT al.cons_id, al.cons_name, al.contract_id, MIN(ch.channel_id) channel_id, ch.gas_cons_object_id, MIN(ch.uug_id) uug_id, MIN(ch.equip_id) equip_id, ch.channel_in, MIN(ch.pc_id) pc_id, MIN(ch.st_id) st_id FROM channel_struct ch JOIN (SELECT ob.gas_cons_object_id gas_cons_object_id, ob.cons_id cons_id, ob.gas_cons_object_name cons_name, ob.contract_id contract_id, dog.contract_to contract_to, dog.contract_num contract_num FROM dbo.gas_cons_object ob JOIN contract dog ON ob.contract_id = dog.contract_id WHERE (ob.reg_id=1000000026 OR ob.reg_id=1000000006) AND dog.contract_to > GETDATE()) al ON ch.gas_cons_object_id = al.gas_cons_object_id WHERE ch.channel_in = 1 AND NOT ch.channel_id is Null AND NOT ch.pc_id is Null AND (ch.dvis =0 OR ch.dvis is Null) GROUP BY al.cons_id, al.cons_name, al.contract_id, ch.channel_in, ch.gas_cons_object_id ORDER BY al.cons_name"
        ishod = query_master(objMyRecordset, objMyCmd, query_text)
        
        ThisWorkbook.Sheets("ID").Range("A2:Z2000").Clear
        ThisWorkbook.Sheets("ID").Range("A2").CopyFromRecordset objMyRecordset
        ThisWorkbook.Sheets("ISSVODKI").Columns("C:C").Interior.Pattern = xlNone

        If IsEmpty(old) Then
        ccccold = -1
        Else
        ccccold = UBound(old, 2)
        End If

        
        cccc = UBound(ishod, 2)
        For i = 0 To cccc
            cons_id = ishod(0, i)
            cons_name = ishod(1, i)
            contract_id = ishod(2, i)
            channel_id = CDbl(ishod(3, i))
            gas_cons_object_id = ishod(4, i)
            uug_id = ishod(5, i)
            equip_id = ishod(6, i)
            channel_in = ishod(7, i)
            pc_id = ishod(8, i)
            st_id = ishod(9, i)
        
        
        For Each one In ThisWorkbook.Sheets("ISSVODKI").Range("B1:B" & ThisWorkbook.Sheets("ISSVODKI").Cells(Rows.Count, 2).End(xlUp).Row)
        If one.Value = channel_id And ThisWorkbook.Sheets("ISSVODKI").Cells(one.Row, 3).Value > 0 And IsNumeric(ThisWorkbook.Sheets("ISSVODKI").Cells(one.Row, 3).Value) Then
        
        writetrue = True
        ddd = date_old
        For ii = 0 To ccccold
        
        
        If CDbl(channel_id) = CDbl(old(0, ii)) And CDbl(contract_id) = CDbl(old(1, ii)) And CStr(old(2, ii)) = CStr(ddd) Then
            writetrue = False
            GoTo nnext
        End If
        
        Next ii
nnext:
        If writetrue Then
        
        query_text_max = "SELECT MAX(id) id FROM add_arc_exps_d"
        max_ = query_master_max(objMyRecordset1, objMyCmd1, query_text_max) + 1
            query_text_edit = "INSERT INTO add_arc_exps_d (channel_id, cur_time, contract_id, cons_id, auto, corr_time, exps_nu, exps_ru, t, p, pb, vs, vw, comm, tag, ext_system_id, fix_status_id, orig_system_id, change_bit, gas_cons_object_id, gas_distr_out_id, uug_id, equip_id, channel_in, koef_cor, pc_id, va, exps_av, id, st_id) VALUES (" & channel_id & ", '" & date_ & "', " & contract_id & ", " & cons_id & ", 0, '" & date__ & "', " & ThisWorkbook.Sheets("ISSVODKI").Cells(one.Row, 3).Value & ", NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, 70, NULL, 70, 1, " & gas_cons_object_id & ", NULL, " & uug_id & ", " & equip_id & ", " & channel_in & ", NULL, " & pc_id & ", NULL, NULL, " & max_ & ", " & st_id & ")"
            query_master1 objMyRecordset3, objMyCmd3, query_text_edit
            ThisWorkbook.Sheets("ISSVODKI").Cells(one.Row, 3).Interior.ColorIndex = 7
        End If
        

        End If
        Next one
        Next i
        
        objMyConn.Close
        
        MsgBox "Done! Imus is Full!"

End Sub


Function query_master(objMyRecordset, objMyCmd, query_test)
        On Error Resume Next
        
        objMyCmd.CommandText = query_test
        objMyCmd.CommandType = adCmdText

        Set objMyRecordset.Source = objMyCmd
        objMyRecordset.Open

      
        query_master = objMyRecordset.GetRows
End Function

Function query_master1(objMyRecordset, objMyCmd, query_test)

        
        objMyCmd.CommandText = query_test
        objMyCmd.CommandType = adCmdText

        Set objMyRecordset.Source = objMyCmd
        objMyRecordset.Open

      

End Function

Function query_master_max(objMyRecordset, objMyCmd, query_test)
        On Error GoTo er
        objMyRecordset.Close
er:
        objMyCmd.CommandText = query_test
        objMyCmd.CommandType = adCmdText

        Set objMyRecordset.Source = objMyCmd
        objMyRecordset.Open
        
        cxxx = objMyRecordset.GetRows
        query_master_max = cxxx(0, 0)

End Function


Function date_()

        y_ = Year(Now())
        m_ = IIf(Month(Now()) <= 9, "0" & Month(Now()), Month(Now()))
        d_ = IIf(Day(Now()) <= 9, "0" & Day(Now()), Day(Now()))
        
        date_ = y_ & m_ & d_ & " " & ThisWorkbook.Sheets("time").Cells(1, 1).Value & ":00:00"

End Function


Function date__()

        y_ = Year(Now())
        m_ = IIf(Month(Now()) <= 9, "0" & Month(Now()), Month(Now()))
        d_ = IIf(Day(Now() - 1) <= 9, "0" & CInt(Day(Now() - 1)), Day(Now() - 1))
        
        date__ = y_ & m_ & d_

End Function

Function date_old()

        y_ = Year(Now())
        m_ = IIf(Month(Now()) <= 9, "0" & Month(Now()), Month(Now()))
        d_ = IIf(Day(Now() - 1) <= 9, "0" & CInt(Day(Now() - 1)), Day(Now() - 1))
        
        date_old = d_ & "." & m_ & "." & y_

End Function

text_in_string.vba

Sub ОтформатитьВТекст()
Dim r As Range
Set wind = Application.InputBox(prompt:="Выберите область", Type:=8)
For Each r In wind
    r.NumberFormat = "@"
    r.FormulaR1C1 = r.FormulaR1C1
Next r
End Sub