Tính số ngày trong tháng

Hỏi: Tôi muốn biết trong tháng có bao nhiêu ngày thì làm thế nào
Đáp: 

Hàm đếm số ngày trong tháng:

Code:

Function totalDayOfMonth(m As Integer, y As Integer) As Integer

totalDayOfMonth = Day(DateSerial(y, m + 1, 0))
End Function

m: tháng cần theo dõi
y: năm cần theo dõi
Kết quả trả về số ngày trong tháng cần theo dõi

Ví dụ:

Private Sub Command0_Click()
Dim m As Integer, y As Integer
m = 2
y = 2010
MsgBox "thang " & m & " nam " & y & " co " & totalDayOfMonth(m, y) & " ngay "
End Sub

kết quả là 28 ngày!
Xem demo Download

____________________________________________________________________________________
Thảo luận thêm: http://thuthuataccess.co.cc/forum

Save as một table thành table khác trong Back-end từ Front-end !

Hỏi: Tôi muốn từ 1 file Access này dùng lệnh kết nối với file Access khác để copy 1 table1 thành table2 thì làm thế nào?

Đáp:

Bạn có thể dùng code sau để run bất cứ lệnh SQL gì ở 1 database nguồn:

Sub runSQLOnfile(mySql As String, myDB As String)
Dim DB As Database
Dim sqlName As QueryDef
' Mở myDB
Set DB = OpenDatabase(myDB)
' tạo 1 query tạm
Set sqlName = DB.CreateQueryDef("")
sqlName.sql = mySql

sqlName.Execute
DB.Close
End Sub

Khi đó bạn có thể gọi đoạn code trên từ một nút nhấn như sau:

Private Sub Command1_Click()
' kết nối DBLuu.mdb
'run SQL trong DBLuu
Dim mySql As String
Dim myDB As String
Dim sAppPath As String
sAppPath = Application.CurrentProject.Path
myDB = sAppPath & "\DBLUU.mdb"
mySql = "SELECT * INTO Table2 FROM Table1"
runSQLOnfile mySql, myDB
MsgBox " Đã copy table thành table 2"
End Sub

Xem Demo: Download
____________________________________________________________________________________
Thảo luận thêm: http://thuthuataccess.com/forum

Xác định số thứ trong một khoảng thời gian

Có một bạn hỏi Muốn xác định số ngày thứ (nhật, 2, 3,4...) trong một khoảng thời gian thì làm thế nào?
Trả lời:
Bạn có thể vào khung soạn code, nhập đoạn code sau vào:

Function demngay(Startdate As Date, Enddate As Date, dayinweek As Integer) As Integer
Dim songay As Integer ' so ngay trong khoang tg do
Dim s As Date 'ngay xem xet
Dim ngay As Integer 'so ngay can tim luy ke
songay = Enddate - Startdate
ngay = 0
s = Startdate
For i = 0 To songay
        If Weekday(s) = dayinweek Then
         ngay = ngay + 1
        End If
        s = s + 1
Next i
demngay = ngay
End Function

Chú ý: tham số day inweek
1:chủ nhật
2:thứ 2
3 thứ 3
4: thứ tư
5: thứ 5
6: thứ 6
7: Thứ 7

Bây giờ bạn có thể gọi từ 1 nút nhấn với tham số truyền từ 2 textbox txtTungay, txtDenngay và 1 combobox tùy biến thứ muốn tìm: cbbThu

Private Sub Command6_Click()
Dim t As Integer
t = demngay(Me.txtTungay, txtDenngay, cbbThu)
MsgBox " Tu ngay " & txtTungay & " den ngay " & txtDenngay & " Co " & t & " ngay thu " & cbbThu
End Sub

Các bạn xem demo Taixuong

____________________________________________________________________________________
Thảo luận thêm: http://thuthuataccess.com/forum

Thao tác với registry (nâng cao)

Trước đây mình có giới thiệu 1 bài viết giúp chúng ta thao tác với registry. Phạm vi bài viết đó chỉ là ghi/ đọc 1 giá trị vào đó nhằm tiện lợi cho lần mở chương trình kế tiếp. Các bạn có thể ứng dụng tùy biến cho user save password hay vài giá trị mà user muốn mặc định...

Xem thêm

Tuy nhiên, do một số nhu cầu đặc biệt, bạn muốn can thiệp sâu hơn vào registry. Điều này đòi hỏi bạn phải có chút am hiểu về nó. Ứng dụng là bạn có thể change workgroup, tạo ổ mạng, setting vài mặc định cho access hay các ứng dụng khác...


Dưới đây mình sẽ giới thiệu vài hàm hỗ trợ ta thao tác với registry :


Reading from the Registry:


Code:

'reads the value for the registry key i_RegKey
'if the key cannot be found, the return value is ""
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

On Error Resume Next
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'read key from registry
RegKeyRead = myWS.RegRead(i_RegKey)
End Function

Checking if a Registry key exists:

Code:

'returns True if the registry key i_RegKey was found
'and False if not
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

On Error GoTo ErrorHandler
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'try to read the registry key
myWS.RegRead i_RegKey
'key was found
RegKeyExists = True
Exit Function

ErrorHandler:
'key was not found
RegKeyExists = False
End Function

Saving a Registry key:

Code:

'sets the registry key i_RegKey to the
'value i_Value with type i_Type
'if i_Type is omitted, the value will be saved as string
'if i_RegKey wasn't found, a new registry key will be created
Sub RegKeySave(i_RegKey As String, _
i_Value As String, _
Optional i_Type As String = "REG_SZ")
Dim myWS As Object

'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'write registry key
myWS.RegWrite i_RegKey, i_Value, i_Type

End Sub

Deleting a key from the Registry:

Code:

'deletes i_RegKey from the registry
'returns True if the deletion was successful,
'and False if not (the key couldn't be found)
Function RegKeyDelete(i_RegKey As String) As Boolean
Dim myWS As Object

On Error GoTo ErrorHandler
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'delete registry key
myWS.RegDelete i_RegKey
'deletion was successful
RegKeyDelete = True
Exit Function

ErrorHandler:
'deletion wasn't successful
RegKeyDelete = False
End Function

Ví dụ sau cho phép bạn startip chương trình unikey lưu trong thư mục D:\\Soft\\UniKey4.0\\unikey40RC2-1101-win32\\UniKeyNT.exe


Key của nó muốn lưu trong registry là

[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run]


"'UniKey"="D:\\Soft\\UniKey4.0\\unikey40RC2-1101-win32\\UniKeyNT.exe"


Ta phát biểu:

Dim key as String, v as String

key="[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run]

'UniKey'"

v="D:\\Soft\\UniKey4.0\\unikey40RC2-1101-win32\\UniKeyNT.exe"

RegKeySave key,v

Chúc thành công!

Ngoài ra việc thao tác với registry bạn phải thật cẩn thận vì có thể làm hỏng cả hệ thống. Nên trước khi làm việc, bạn nên sao lưu 1 bản dự phòng bất trắc.

____________________________________________________________________________________
Thảo luận thêm: http://thuthuataccess.com/forum

Lập trình giao tiếp Web Server bằng thư viên WinHttp trên Access

Trên thực tế, rất nhiều dữ liệu ta cần lấy từ web, hoặc nhập liệu lên web site từ MS Access.
Bài viết dưới đây của mình nhằm hướng dẫn các bạn khái niệm cơ bản nhất để làm 1 ứng dụng tương tác Web server bằng Access thông qua thư viện winhttp

Để sự dụng thư viện này, các bạn phải khai báo trong khung soạn thảo code

Đầu tiên. Bạn tạo 1 file MDB mới. Tạo 1 form mới và vẽ
1 textbox tên texbox1
1 nút command button tên command1
1 đối tượng image tên pisture 1.

Trong khung soạn VBA, nhập đoạn code sau vào.

Sub getPicture(url As String)
Set WinHttpReq = New WinHttpRequest

 ' Tạo một mảng chứa dữ liệu trả về
    Dim d() As Byte
   
    ' Mở 1 thủ tục một yêu cầu lấy dữ liệu
    WinHttpReq.Open "GET", url, False

    ' Gửi yêu cầu đó tới server
    WinHttpReq.Send
   
    ' Lấy về tiến trình tải về .
    Text1.Value = WinHttpReq.Status & " - " & WinHttpReq.StatusText

    ' Đưa dữ liệu nhận được vào mảng đã khai báo với file tạm là temp.gif trong bộ nhớ
    Open "temp.jpg" For Binary As #1
    d() = WinHttpReq.ResponseBody
    Put #1, 1, d()
    Close
   
    ' gán file vào giá trị đối tượng picture tạo sẵn
    Picture1.Picture = "temp.jpg"
End Sub

Trong hành động click nút nhấn, ta gọi thủ tục trên:

Private Sub Command1_Click()
getPicture "http://i39.photobucket.com/albums/e193/duytuan2002/Access/Thuthuataccess.jpg"
End Sub
 

Giờ bạn xem điều kì diệu xảy ra.
Down load demo ở đây: Click

Về tương lai có lẽ các bài hướng dẫn của mình sẽ hướng tương tác web. Mình sẽ cập nhật những gì học được sau.
các bạn có thể tham khảo các hàm của thư viện winhttp trên trang web của microsoft:
http://msdn.microsoft.com/en-us/library/aa383979%28v=VS.85%29.aspx
____________________________________________________________________________________
Thảo luận thêm: http://thuthuataccess.co.cc/forum

Kiểm tra kiểu dữ liệu của fields

Hỏi: tôi có một table có field MASO, tôi không rõ kiểu dữ liệu của Field. Muốn tự động kiểm tra xem Field đó có kiểu dữ liệu là gì (haquocquan)

Đáp:

Nhập function sau vào:

Tùy biến chọn file Excel để Import vào Acces

Chú ý, để sử dụng được các đối tượng có sẵn của Office, bạn phải khai báo sữ dụng thư viện Office bằng cách vào cửa sổ VBA, Menu Tool--> references, chọn Microsoft Office 11.0 library. (chọn 10.0 đối với AccessXP)


Và bây giờ bắt đầu:

Tạo 1 form tên là frmTest
Vẽ 1 Textbox tên là txtPath.
Vẽ 1 nút nhấn là cmdSelectfile
Vẽ 1 textBox đặt là txtRange để bạn nhập tên sheet muốn import vào
Vẽ 1 Textbox đặt tên là txtTable để bạn nhập tên Table muốn lưu
Vẽ 1 nút nhấn có tên cmdImport
Tạo 1 module copy đoạn code sau vào:

Function getFile(Tit As String, formatName As String, formatType As String)
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
.Title = Tit
.Filters.Clear
.Filters.Add formatName, formatType
.AllowMultiSelect = False
result = .Show
If (result <> 0) Then
getFile = Trim(dlgOpen.SelectedItems.Item(1))
End If
End With

End Function

Và lưu thành tên Module 1
Trong event Onclick của nút cmdSelectfile, ta nhập như sau:

Private Sub cmdSelectfile_Click()
Me![txtPath] = getFile("c:\", "Select the Excel File", "*.xls")
End Sub

Trong event Click của nút cmdImport, ta nhập như sau:

Private Sub cmdImport_Click()

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, txtTenTable, txtPath, True, txtRange
MsgBox "import thanh cong"
End Sub

Giờ sử dụng: đầu tiên ta click vào nút cmdSelectfile để chọn file Excel muốn import
Nhập tên Sheet muốn import vào txtRange (ví dụ: Sheet1:A1:H300)
Nhập tên table muốn lưu. (Ví dụ: Table1)
Và nhấn Nút Import
Rồi hưởng thành quả

DownloadDemo

____________________________________________________________________________________
Thảo luận thêm: http://thuthuataccess.co.cc/forum