vbs操作EXel_grtctx.dbuploadcfg-CSDN博客

本文链接：https://blog.csdn.net/shililu/article/details/10143087

'author
'shili
Option Explicit
dim date_Y,date_M
dim ExcelApp
dim oExcel,countte,count

Class partner_rules

Public CFG_EXCELPATH
Public CFG_EXCELMODEL
Public oArgs
dim sDate
Public sub init()

      dim file_path,Client_Name,file_name
  CFG_EXCELPATH=gRTCtx.FSO.GetParentFolderName(WScript.ScriptFullName)
     CFG_EXCELPATH=Left(CFG_EXCELPATH, InStrRev(CFG_EXCELPATH,"\")-1)
  Set oArgs=WScript.Arguments
     file_path=oArgs(0)
   Client_Name = oArgs(1)
  sDate = oArgs(2)
  file_name=oArgs(3)
     CFG_EXCELMODEL=file_path&"\"&file_name
  'CFG_EXCELPATH=getCurPATH &"\template\lumingwen.xlsx"
  'Call MoveMailFiles(CFG_EXCELPATH,CFG_EXCELMODEL)
     '错误控制，开关为off
   Set oExcel=CreateObject("Excel.Application")
   oExcel.Visible = True
   Set ExcelApp=oExcel.Workbooks.Open(CFG_EXCELMODEL)
   oExcel.DisplayAlerts=FALSE
end sub
    '执行函数
    Public sub process()

    call init()
'调用类

'连接数据库

dim mobjDBSELECT
DB_name = "Lmw_REPORTMANAGEMNTSYSTEMTest"
username = "root"
password = "cordys"
server = "192.168.100.173"
if getMySQLConnection(conn,server,DB_name,username,password) then
   '连接成功
   'msgbox " connection success"
else
   ' 连接不成功
end if
ExcelApp.WorkSheets("message").cells(1,1).Font.Name = "ＭＳＰゴシック"
ExcelApp.WorkSheets("message").Rows(1).Font.Size=12
    ExcelApp.WorkSheets("message").Rows(1).Font.Bold = True
    ExcelApp.WorkSheets("message").cells(1,1).value = "基準書 "
    ExcelApp.WorkSheets("message").cells(1,2).value = "【全クライアント】アフィリエイトパートナーサイト提携基準 "
ExcelApp.WorkSheets("message").cells(1,5).value ="改定"
    ExcelApp.WorkSheets("message").cells(1,6).value = date_Y & "年" & date_M & "月"
    ExcelApp.WorkSheets("message").cells(1,7).value = "澤口　淳"
ExcelApp.WorkSheets("message").cells(1,1).select

call edit_report()

   'ブックを保存Excelを終了する
    ExcelApp.SaveAs CFG_EXCELMODEL
oExcel.Quit
Set oExcel=Nothing

end sub

Function getCurPATH()
     Dim objFS
   Dim strCurPath
    Set objFS = CreateObject("Scripting.FileSystemObject")
   getCurPATH = objFS.GetParentFolderName(WScript.ScriptFullName)
     Set objFS = Nothing
End Function

end class
function getMySQLConnection(ByRef tmpCon, ByVal tmpSVName, ByVal tmpDBName, ByVal tmpUID, ByVal tmpPWD)

Set tmpCon = Createobject("ADODB.Connection")

    On Error Resume Next
    'MySQL用のADOコネクションを作成します
      tmpCon.Open "Driver={MySQL ODBC 5.1 Driver};" _
          & "server=" & tmpSVName & ";" _
          & "database=" & tmpDBName & ";" _
          & "uid=" & tmpUID & "; pwd=" & tmpPWD & ";"
    'コネクションの結果を判定
    If Err.Number = 0 Then
       getMySQLConnection = True 'コネクション成功
    Else
       getMySQLConnection = False 'コネクションエラー
    End If

End function
sub edit_report()
dim i,res_sql,count1,count2,countt,j
dim objdata,objdata1,i2
Set res_sql=new table_class
count=res_sql.select_count()
i2=2
For i=0 to (count-1) step 1
'得到没一个objct_cd对应的总数,这就是没以个对应的总数，可以通过这个指定插入到了那里了
   count1=res_sql.select_count1("0"&i&"")
   count2=res_sql.select_count1("0"&(i+1)&"")

   countte=countte+count1
   objdata1=res_sql.select_data1("0"&(i+1)&"")
   objdata=res_sql.select_data()

   dim MyArrary,y,i1
   '##########控制第二列的值分几行显示
   'if 为不为空

   If ""&objdata(i,1)<>"" Then
   i1=0
   MyArrary=Split(objdata(i,1),"<br>")
   For Each y In MyArrary
    ExcelApp.WorkSheets("message").Rows(countte+i2+i1+1).Interior.Color=RGB(255,255,255)
    ExcelApp.WorkSheets("message").cells((countte+i2+i1),1).value = objdata(i,0)
    ExcelApp.WorkSheets("message").cells((countte+i2+i1),7).value =y
'######设置字体#####

ExcelApp.WorkSheets("message").Rows(countte+i2+i1).Font.Name = "ＭＳＰゴシック"
    ExcelApp.WorkSheets("message").Rows(countte+i2+i1).Font.Size=11
    ExcelApp.WorkSheets("message").Rows(countte+i2+i1).Font.Bold = True
    'ExcelApp.WorkSheets("message").Rows(countte+i2+i1).Font.UnderLine = True
'##################
ExcelApp.WorkSheets("message").cells(countte+i2+i1,7).HorizontalAlignment = 2
ExcelApp.WorkSheets("message").cells(countte+i2+i1,7).VerticalAlignment = 1
ExcelApp.WorkSheets("message").range("A"&(countte+i2)&"","F"&(countte+i2+i1)&"").Merge
i1=i1+1
MsgBox("#####"&i1)
   Next
    i2=i2+i1
msgBox("i2#####"&i2)
   ElseIf objdata(i,1)="Null" Then
      msgBox("null*******")
     ExcelApp.WorkSheets("message").cells((countte+i2),1).value = objdata(i,0)
   i2=i2+1
   Else
    ExcelApp.WorkSheets("message").cells((countte+i2),1).value = objdata(i,0)
i2=i2+1
   End if
If count2 <>0 then
   MsgBox("count2"&count2)
'##############################################
   MsgBox("i2="&i2)
'输出内容
'#####设置底色
   ExcelApp.WorkSheets("message").Rows(countte+i2).Interior.Color=RGB(191,191,191)
   ExcelApp.WorkSheets("message").Rows(countte+i2).Font.Name = "ＭＳＰゴシック"
   ExcelApp.WorkSheets("message").Rows(countte+i2).Font.Bold = True
'ExcelApp.WorkSheets("message").Rows(countte+i2+i1).Font.Color =RGB(192,192,192)
   ExcelApp.WorkSheets("message").cells((countte+i2),1).value ="サイトカテゴリ"
   ExcelApp.WorkSheets("message").cells((countte+i2),2).value = "記入文言"
   ExcelApp.WorkSheets("message").cells((countte+i2),3).value = "内容"
   ExcelApp.WorkSheets("message").cells((countte+i2),4).value ="プロミス様"
   ExcelApp.WorkSheets("message").cells((countte+i2),5).value = "モビット様"
   ExcelApp.WorkSheets("message").cells((countte+i2),6).value = "住商様"
   ExcelApp.WorkSheets("message").cells((countte+i2),7).value = "セントメディア様"
   'ExcelApp.WorkSheets("message").cells((countte+2*i+2),1).value = objdata(i,0)

   'oExcel.activeSheet.Range("A"&(countte+2*i+4)&"","G"&(countte+2*i+4+count2)&"").value=objdata1
   '循环取出每一条下面的值，并且放在表格之中
   For j=1 to count2
   ExcelApp.WorkSheets("message").Rows(countte+i2+j).Font.Name = "ＭＳＰゴシック"
   ExcelApp.WorkSheets("message").cells((countte+j+i2),1).value = objdata1(j,0)
   ExcelApp.WorkSheets("message").cells((countte+j+i2),2).value = objdata1(j,1)
   ExcelApp.WorkSheets("message").cells((countte+j+i2),3).value = objdata1(j,2)
   ExcelApp.WorkSheets("message").cells((countte+j+i2),4).value = objdata1(j,3)
   ExcelApp.WorkSheets("message").cells((countte+j+i2),5).value = objdata1(j,4)
   ExcelApp.WorkSheets("message").cells((countte+j+i2),6).value = objdata1(j,5)
   ExcelApp.WorkSheets("message").cells((countte+j+i2),7).value = objdata1(j,6)
   next
   else
     ExcelApp.WorkSheets("message").Rows(countte+i2).Font.Name = "ＭＳＰゴシック"
     ExcelApp.WorkSheets("message").cells((countte+i2),1).value ="※判断が難しいサイトがあった場合は保留サイトとして報告すること。"
ExcelApp.WorkSheets("message").cells((countte+i2+1),1).value ="※GoogleAdsense、MicroAdはチェック対象外。"
ExcelApp.WorkSheets("message").cells((countte+i2+2),1).value ="※ブロピタ等、掲載しても問題ない動画コンテンツがある場合は随時提携承認基準に追加する。"
ExcelApp.WorkSheets("message").cells((countte+i2+3),1).value ="※出会い系のサイトで、掲載しても問題のないサイトがある場合は随時提携承認基準に追加する。"
'count=count-1
     Call A()
End If
next

end sub

Public Sub A()
'来格式化表格之中的内容.countte是来自于全局变量在最顶部，作用是来记录有多少条记录
MsgBox(countte+2*count+1)
dim i,j,sum,number,number2
sum=countte+2*count+1
number=1
number2 = 1
For i=2 to sum
   '判断要是第一列的单元格内容，如果相等，就合并
if ExcelApp.WorkSheets("message").cells(i,1).value=ExcelApp.WorkSheets("message").cells(i+1,1).value Then
  number=number+1
else
   ExcelApp.WorkSheets("message").range(ExcelApp.WorkSheets("message").cells(i-number+1,1),ExcelApp.WorkSheets("message").cells(i,1)).Merge
   ExcelApp.WorkSheets("message").cells(i-number+1,1).HorizontalAlignment = 2
   ExcelApp.WorkSheets("message").cells(i-number+1,1).VerticalAlignment = 1
   number=1
End if
If ExcelApp.WorkSheets("message").cells(i,2).value=ExcelApp.WorkSheets("message").cells(i+1,2).value Then
  number2=number2+1
else
   ExcelApp.WorkSheets("message").range(ExcelApp.WorkSheets("message").cells(i-number2+1,2),ExcelApp.WorkSheets("message").cells(i,2)).Merge
   '设置内容居上显示
   ExcelApp.WorkSheets("message").cells(i-number2+1,2).HorizontalAlignment = 2
   ExcelApp.WorkSheets("message").cells(i-number2+1,2).VerticalAlignment = 1
   number2=1
End if
ExcelApp.WorkSheets("message").cells(i-number+1,3).HorizontalAlignment = 2
ExcelApp.WorkSheets("message").cells(i-number+1,3).VerticalAlignment = 1
Next
end Sub
Public Sub DBUpload_Start()
Call GLOBAL_DBUploadSmit
Dim pro
Set pro = New partner_rules
Call pro.Process()
End Sub