http://vb.ncis.com.tw/LMVB2.0/exp/exp.html
VB新增資料表或資料庫.
http://tw.knowledge.yahoo.com/question/question?qid=1607042107814
======================================================================================================================
設定資料新增或修改的警告視窗
----------------------------
DoCmd.SetWarnings False
======================================================================================================================
詢問視窗
--------
If MsgBox("確定清除資料嗎?", vbYesNo) = vbNo Then
Exit Sub
End If
======================================================================================================================
檔案匯入匯出
------------
DoCmd.TransferText([TransferType], SpecificationName, TableName, FileName, HasFieldNames, HTMLTableName, CodePage)
[TransferType] 可為下列其中一種 AcTextTransferType 常數。
acExportDelim
acExportFixed
acExportHTML
acExportMerge
acImportDelim 預設值
acImportFixed
acImportHTML
acLinkDelim
acLinkFixed
acLinkHTML
DoCmd.TransferText 1, "Endtrn_DownLoadData", "Endtrn_DownLoadData", Index_txt_1, False, ""
DoCmd.TransferText acImportFixed, "CU_File 匯入規格", "BC_CUFile", "C:\xxx\xxx.txt"
======================================================================================================================
Txt檔案匯入
------------------------------------------------------------------------------------------------------------------------
Private Sub btn_InputFile_Click()
Dim sL_RPT_FP As String '匯入檔案路徑
Dim iL_ReadLine As Integer '開始讀取行數
Dim iL_CellsY As Integer '陣列Y軸
Dim Cells() As String '陣列
iL_CellsY = 0
iL_ReadLine = 20
sL_RPT_FP = Form_Main.txt_RPTFilePath '路徑
If f_ChackPath(sL_RPT_FP) Then '檢查路徑是否有檔案，副程式 f_ChackPath()
Open sL_RPT_FP For Input As #1 '假設讀取檔名為c:\list.txt
i = 1 '陣列從第一列開始放資料
While Not EOF(1) '讀完資料就結束,或使用for loop讀取
Line Input #1, strtext '讀入每一行資料
If i > iL_ReadLine And Trim(strtext) <> "" Then
iL_CellsY = i - iL_ReadLine '從1開始放資料到陣列
strtext = Trim(strtext) '去空白
ReDim Preserve Cells(9, iL_CellsY) '重新宣告陣列長度
Cells(1, iL_CellsY) = Trim(Mid(strtext, 1, 9)) '讀取資料，寫入陣列
Cells(2, iL_CellsY) = Trim(Mid(strtext, 17, 10))
Cells(3, iL_CellsY) = Trim(Mid(strtext, 29, 9))
Cells(4, iL_CellsY) = Trim(Mid(strtext, 44, 10))
Cells(5, iL_CellsY) = Trim(Mid(strtext, 60, 10))
Cells(6, iL_CellsY) = Trim(Mid(strtext, 75, 6))
Cells(7, iL_CellsY) = Trim(Mid(strtext, 93, 3))
Cells(8, iL_CellsY) = Trim(Mid(strtext, 106, 35))
Cells(9, iL_CellsY) = Trim(Mid(strtext, 141, 14))
End If
i = i + 1
Wend
Close #1
MsgBox ("匯入完成!!")
End If
End Sub
------------------------------------------------------------------------------------------------------------------------
If Dir(Index_txt_2) = "" Then
MsgBox "檔案不存在!"
Exit Sub
End If
DoCmd.SetWarnings False
DoCmd.TransferText 1, "OUTTRN_DownLoadData", "OUTTRN_DownLoadData", Index_txt_2, False, ""
Call SQL_Insert_OUTTRN
list_OUTST_1.Requery
DoCmd.SetWarnings True
MsgBox "OUTTRN匯入完成!!"
Public Sub PertTotal_Chank()
Dim Dba As Database
Dim rs1 As Recordset
Set Dba = CurrentDb
Dim strYear As String
Dim strInsu_Cont_Code As String
strYear = IIf(IsNull(Form_首頁.list_INSU_Year), "", Trim(Form_首頁.list_INSU_Year))
strInsu_Cont_Code = IIf(IsNull(Form_首頁.ddl_INSU_Insu_Cont_Code), "", Trim(Form_首頁.ddl_INSU_Insu_Cont_Code))
Dim strSQL As String
'年度
If strYear <> "" And strInsu_Cont_Code <> "" Then
strSQL = "Select Sum(Cint([Pert])) As PTotal FROM [T_INSU_CONT] Where 1=1"
strSQL = strSQL + " And [Cnta_Year]='" & strYear & "' And [Insu_Cont_Code]='" & strInsu_Cont_Code & "'"
Set rs1 = Dba.OpenRecordset(strSQL)
Do While Not rs1.EOF
Form_首頁.txt_PTotal = rs1("[PTotal]")
rs1.MoveNext
Loop
Else
Exit Sub
End If
Set rs1 = Nothing
End Sub
Public Function OnClick_ENDTRN_List_1()
Dim Dba As Database
Dim rs1 As Recordset
Dim strSQL As String
Dim intSUM As Double
'Dim intSUM As Integer
intSUM = 0
Set Dba = CurrentDb
strSQL = ""
strSQL = strSQL + " Select Distinctrow 批單共保號碼, 保單共保號碼, 入帳年月"
strSQL = strSQL + " , 本次批改共保保費, 公司分回比例, 本次批改共保保費_MD, 本次批改共保保費_TPL"
strSQL = strSQL + " , 本次批改共保保費_NH, Comp_Code"
strSQL = strSQL + " From Select_T_ENDR_MNTH"
strSQL = strSQL + " Where 批單共保號碼 = '" & Form_首頁.list_2.Value & "'"
Set rs1 = Dba.OpenRecordset(strSQL)
Do While Not rs1.EOF
intSUM = (rs1("[本次批改共保保費_MD]") * (rs1("[公司分回比例]") / 100))
intSUM = intSUM + rs1("[本次批改共保保費_TPL]") * (rs1("[公司分回比例]") / 100)
intSUM = intSUM + rs1("[本次批改共保保費_NH]") * (rs1("[公司分回比例]") / 100)
Form_首頁.txt_END_1 = rs1("[批單共保號碼]")
Form_首頁.txt_END_7 = CLng(intSUM) - CLng(Form_首頁.txt_END_5) - CLng(Form_首頁.txt_END_6)
Form_首頁.txt_END_11 = intSUM
Form_首頁.txt_Comp_Code = rs1("[Comp_Code]")
rs1.MoveNext
Loop
Set rs1 = Nothing
End Function
======================================================================================================================
資料表 匯出 Excel檔案
-----------------
Dim strSQL As String
Dim Dba As Database
Dim tB As TableDef
Set Dba = CurrentDb
For Each tB In Dba.TableDefs
If tB.Name = "BBB" Then
Dba.TableDefs.Delete tB.Name
Exit For
End If
Next
strSQL = ""
strSQL = strSQL + " Select A1 As 第一欄, A2 As '第二欄', A3 As '第三欄'"
strSQL = strSQL + " Into BBB"
strSQL = strSQL + " From aaa"
Dba.Execute (strSQL)
Set tB = Nothing
Dba.Close
Set Dba = Nothing
Dim sL_FilePath As String
sL_FilePath = "D:\BBB.xls"
If Dir(sL_FilePath) <> "" Then Kill sL_FilePath
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "BBB", sL_FilePath, True, ""
留言列表
