DoCmd.OutputTo acOutputReport, "R02-Currentstock", acFormatXLS, "C:\1.xls", -1Thì bạn cứ thay đổi đường dẫn đến file đó là được.
Làm cho bạn cái dialog mở theo ý muốn.
Option Compare Database
Private Sub cmdCapNhat_Click()
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.FileName) > 0 Then
strFileName = .FileName
Else
Exit Sub
End If
End With
With DoCmd
.SetWarnings (False)
sSQL = "UPDATE [TB hang hoa] b " _
& "RIGHT JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & strFileName & "].[Sheet1$B4:G18] a " _
& "ON a.Mahang=b.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
DoCmd.RunSQL sSQL
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
Set fd = Nothing
End Sub
Private Sub cmdLayDuLieu_Click()
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.FileName) > 0 Then
strFileName = .FileName
Else
Exit Sub
End If
End With
With DoCmd
.SetWarnings (False)
.RunSQL "Delete * from [TB hang hoa]"
.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
"TB hang hoa", strFileName, True, "B4:G18"
Me.RecordSource = "TB hang hoa"
.SetWarnings (True)
End With
Set fd = Nothing
End SubSub HLMT_Update()
On Error GoTo loi
Set Cn = CreateObject("ADODB.Connection")
Dim mySQL As String
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.Filename) > 0 Then
strFileName = .Filename
Else
Exit Sub
End If
End With
With Cn
mySQL = "UPDATE [TB hang hoa] b " _
& "right JOIN " _
& "[Excel 8.0;HDR=Yes;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[Sheet1$B4:G600] a " _
& "ON b.Mahang=a.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
.ConnectionString = "Data Source=" & strFileName
.CursorLocation = adUseClient
.Open
.Execute mySQL
.Close
End With
Set Cn = Nothing
Set fd = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub
Sub HLMT_LayDuLieu()
Dim cnn As Object, rst As Object, strCNString As String, lsSQL As String
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim fd As Object, strFileName As String
Set fd = CreateObject("MSComDlg.CommonDialog")
With fd
.ShowOpen
If Len(.Filename) > 0 Then
strFileName = .Filename
Else
Exit Sub
End If
End With
strCNString = "Data Source=" & strFileName
On Error GoTo loi
With cnn
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
.ConnectionString = strCNString
.CursorLocation = adUseClient
.Open
End With
lsSQL = "SELECT * " & _
"FROM [TB hang hoa]"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Range("B5:G6000").ClearContents
Range("B5").CopyFromRecordset rst
rst.Close: cnn.Close
Set rst = Nothing: Set cnn = Nothing
Set fd = Nothing
Exit Sub
loi:
MsgBox Err.Description
End SubSub HLMT_Update()
On Error GoTo loi
Set Cn = CreateObject("ADODB.Connection")
Dim mySQL As String
Dim strFileName
strFileName = Application.GetOpenFilename()
With Cn
mySQL = "UPDATE [TB hang hoa] b " _
& "right JOIN " _
& "[Excel 8.0;HDR=Yes;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[Sheet1$B4:G600] a " _
& "ON b.Mahang=a.Mahang " _
& "SET b.ngay=a.ngay,b.Mahang=a.Mahang,b.tenhang=a.tenhang," _
& "b.makholuutru=a.makholuutru,b.tenkholuutru=a.tenkholuutru," _
& "b.Soluongban=a.Soluongban " _
& "where a.mahang is not null"
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
.ConnectionString = "Data Source=" & strFileName
.CursorLocation = adUseClient
.Open
.Execute mySQL
.Close
End With
Set Cn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub
Sub HLMT_LayDuLieu()
Dim cnn As Object, rst As Object, strCNString As String, lsSQL As String
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim strFileName
strFileName = Application.GetOpenFilename()
strCNString = "Data Source=" & strFileName
On Error GoTo loi
With cnn
.Provider = "Microsoft Jet 4.0 OLE DB Provider"
.ConnectionString = strCNString
.CursorLocation = adUseClient
.Open
End With
lsSQL = "SELECT * " & _
"FROM [TB hang hoa]"
rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
Range("B5:G6000").ClearContents
Range("B5").CopyFromRecordset rst
rst.Close: cnn.Close
Set rst = Nothing: Set cnn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End SubBạn xem file đính kèm nhé, về code ngắn hơn thì mình chưa nghĩ ra, bạn tạm dùng thế nhé.
