automation, gunakan cara dari
http://www.mvps.org/access/tables/tbl0012.htm
aksan kurdin
'*********** Code Start ************
' This code was originally written by Timothy Pascoe and Lyle Fairfield
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Timothy Pascoe and Lyle Fairfield
'
Const IntAttachedTableType As Integer = 6
Const ALLFILES = "All Files"
Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String
strFilter = ahtAddFilterItem(strFilter, _
"Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
"*.mdb; *.mda; *.mde; *.mdw")
strFilter = ahtAddFilterItem(strFilter, _
"All Files (*.*)", _
"*.*")
fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:=strIn, _
Flags:=ahtOFN_HIDEREADONLY)
End Function
Function fRefreshLinks() As Boolean
' Code courtesy of:
' Microsoft Access 95 Solutions database
' Modified for Multiple Back-ends by Lyle Fairfield
' Updated to handle cancelation/incorrect selection by Timothy J. Pascoe
' Except where otherwise noted.
Dim dbs As Database
Dim rst As Recordset, rstTry As Recordset
Dim tdf As TableDef
Dim strOldConnect As String, strNewConnect As String
Dim strFullLocation As String, strDatabase As String, strMsg As String
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("SELECT MSysObjects.Connect, MsysObjects.Database, " & _
"MSysObjects.Name from MSysObjects " & _
"WHERE MSysObjects.Type = " & IntAttachedTableType)
If rst.RecordCount <> 0 Then
rst.MoveFirst
Do
On Error Resume Next
Set rstTry = dbs.OpenRecordset(rst![Name].Value)
If Err = 0 Then
rstTry.Close
Set rstTry = Nothing
Else
On Error GoTo fRefreshLinks_Err
strFullLocation = rst.Name
strDatabase = FileName(strFullLocation)
Set tdf = dbs.TableDefs(rst![Name].Value)
strOldConnect = tdf.Connect
strNewConnect = findConnect(strDatabase, tdf.Name, strOldConnect)
'If strNewConnect = "" Then
'Err.Raise
'Else
For Each tdf In dbs.TableDefs
If tdf.Connect = strOldConnect Then
tdf.Connect = strNewConnect
tdf.RefreshLink
End If
Next tdf
dbs.TableDefs.Refresh
'End If
End If
Err = 0
rst.MoveNext
If rst.EOF Then
Exit Do
End If
Loop
End If
fRefreshLinks_End:
Set tdf = Nothing
Set rst = Nothing
Set rstTry = Nothing
fRefreshLinks = True
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case Err
Case 3024:
Case Else:
strMsg = "Error Information..." & vbCrLf & vbCrLf
strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Error"
End Select
Exit Function
End Function
Function findConnect(strDatabase As String, strFileName As String, strConnect As String) As Variant
Dim strSearchPath As String, strFileType As String, strFileSkelton As String
Dim aExtension(6, 1) As String, i As Integer, _
strFindFullPath As String, strFindPath As String, strParameters As String
strSearchPath = directoryFromConnect(strConnect)
strFileType = "All Files"
strFileSkelton = "*.*"
aExtension(0, 0) = "dBase"
aExtension(0, 1) = ".dbf"
aExtension(1, 0) = "Paradox"
aExtension(1, 1) = ".db"
aExtension(2, 0) = "FoxPro"
aExtension(2, 1) = ".dbf"
aExtension(3, 0) = "Excel"
aExtension(3, 1) = ".xls"
aExtension(4, 0) = "Text"
aExtension(4, 1) = ".txt"
aExtension(5, 0) = "Exchange"
aExtension(5, 1) = ".*"
aExtension(6, 0) = "Access"
aExtension(6, 1) = ".mdb"
For i = 0 To 6
If InStr(strConnect, aExtension(i, 0)) <> 0 Then
strFileName = strFileName & aExtension(i, 1)
strFileSkelton = "*" & aExtension(i, 1)
strFileType = aExtension(i, 0)
Exit For
End If
Next i
strFindFullPath = findFile(strDatabase, strSearchPath, strFileType, strFileSkelton)
If strFindFullPath <> "" Then
strFindPath = strPathfromFileName(strFindFullPath)
strParameters = parametersFromConnect(strConnect)
If InStr(strFindFullPath, "dbf") <> 0 Then
findConnect = strParameters & strFindPath
Else
findConnect = strParameters & strFindFullPath
End If
End If
End Function
Function directoryFromConnect(strConnect As String) As String
directoryFromConnect = Mid(strConnect, InStr(strConnect, "DATABASE=") + 9)
End Function
Function parametersFromConnect(strConnect As String) As String
parametersFromConnect = left(strConnect, InStr(strConnect, "DATABASE=") + 8)
End Function
Function strPathfromFileName(strFileName As String) As String
Dim i As Integer
For i = Len(strFileName) To 1 Step -1
If Mid(strFileName, i, 1) = "\" Then
Exit For
End If
Next i
strPathfromFileName = left(strFileName, i - 1)
End Function
Function findFile(strDatabase, strSearchPath, strFileType, strFileSkelton) As String
Dim strSelectedDatabase As String, strFullLocation As String, intlen As Integer, i As Integer
Dim strIn As String
Do
strIn = "Where Is " & strDatabase & "?"
findFile = Trim(fGetMDBName(strIn))
strSelectedDatabase = FileName(findFile)
If strSelectedDatabase = "" Then
Exit Do
ElseIf strDatabase <> strSelectedDatabase Then
MsgBox "You selected " & strSelectedDatabase & _
"@This is not the correct database.@Please select " & _
strDatabase & ".", vbInformation + vbOKOnly
End If
Loop Until strSelectedDatabase = strDatabase
End Function
Public Function FileName(strFullLocation As String)
Dim intlen As Integer, i As Integer
'Get the Database Name, for use on the 'Find File' Form Caption
intlen = Len(strFullLocation)
For i = intlen To 1 Step -1
If Mid$(strFullLocation, i, 1) = "\" Then
FileName = right$(strFullLocation, intlen - i)
Exit For
End If
Next i
End Function
'*********** Code End ************
--- In belajar-access@yahoogroups.com, Hendra Agestha Hamid <the_agestha@...> wrote:
>
> Itu pake fasilitas link manager tu ya mas..?
>
>
>
>
>
> ________________________________
> From: Aksan Kurdin <aksan.kurdin@...>
> To: belajar-access@yahoogroups.com
> Sent: Mon, November 1, 2010 10:50:22 AM
> Subject: Re: [belajar-access] [ASK] Sharing File Access Untuk Multi-user
>
> betul sekali.
> secara programming itu mudah dilakukan.
>
> aksan kurdin
>
>
> On 11/1/2010 10:44 AM, Hendra Agestha Hamid wrote:
> Maaf nimbrung mas Aksan,...
> >
> >Mas berarti kita me - relink lagi ya mas semua aplikasi FE yg ada di
> >workstation utk menyimpan BE yg ada di shared folder..? saya
> >membayangkan BE yg tadinya kita buat di laptop kita contoh di
> >D:\master\data.mdb terus akan kita pasang di jaringan kantor tentunya
> >linknya harus berubah sesuai BE itu ditaruh...mohon penjelasannya
> >mas...
> >
> >Regards
> >Hendra
> >
> >
> >
> >
> ________________________________
> From: Aksan Kurdin <aksan.kurdin@...>
> >To: belajar-access@yahoogroups.com
> >Sent: Mon, November 1, 2010 10:00:32 AM
> >Subject: Re: [belajar-access] [ASK] Sharing File Access Untuk
> >Multi-user
> >
> >cara terbaik adalah yang nomor 3.
> >
> >keuntungan dipisahkannya aplikasi dari database adalah, dalam
> >pengembangan ke depan. Kita bisa melakukan develop di tempat
> >terpisah, di kantor atau di rumah. hasil jadinya baru di deploy.
> >tetapi kalau masih jadi satu di server, kita masih harus nunggu
> >sampai database gak terpakai baru bisa melakukan
> >perubahan-perubahan.
> >yang kedua, selama masa develop, bisa jalan paralel transaksi yang
> >berlangsung, tidak menunggu sampai develop selesai, karena develop
> >lepas dari production.
> >yang ketiga, jika bermain vba, tidak bisa melakukan buka multi user
> >untuk module/class module.
> >
> >aksan kurdin
> >
> >On 11/1/2010 9:36 AM, Ary Januwar wrote:
> >terima kasih master aksan,
> >>
> >>klo misalkan rekan kita blum terlalu paham tentang akses
> >>sepertinya pake cara yang ke 2 ya master ?
> >>karena klo aplikasi kan mereka tinggal buka, input, save dan
> >>close.
> >>
> >>AJ
> >>
> >>
> >>
> >>
> ________________________________
> From: Aksan Kurdin <aksan.kurdin@...>
> >>To: belajar-access@yahoogroups.com
> >>Sent: Sat, October 30, 2010 2:40:48 PM
> >>Subject: Re: [belajar-access] [ASK] Sharing File Access
> >>Untuk Multi-user
> >>
> >>Ada beberapa cara:
> >>1. File mdb anda taruh di folder yang anda share full
> >>access, lalu rekan anda yang terkonek jaringan dan mendapat
> >>access share bisa langsung menggunakannya. Pastikan opsi
> >>shared sudah diaktifkan.
> >>
> >>
> >>
> >>2. sama seperti cara nomor 1, tetapi letak access anda
> >>adalah di 'server' (file server).
> >>3. pecah access menjadi dua bagian. satu berisi hanya tabel
> >>(sebutannya Back End / BE) dan satu lagi berisi semua obyek
> >>yang lain (query, form, report, macro, module) (sebutannya
> >>Front End / FE). BE bersifat sebagai database, FE bersifat
> >>sebagai aplikasi. Antara FE dan BE merupakan hubungan link
> >>tabel. BE taruh di folder share, FE taruh di semua
> >>workstation yang membutuhkan.
> >>
> >>aksan kurdin
> >>
> >>
> >>
> >>On 10/30/2010 2:21 PM, Ary wrote:
> >>
> >>>Dear master dan suhu,
> >>>
> >>>mohon penjelasan dan langkah2 mengenai sharing file
> >>>access supaya bisa digunakan oleh multi-user. saya
> >>>pakai access 2007.
> >>>
> >>>
> >>>sebelum dan sesudahnya saya ucapkan terima kasih.
> >>>
> >>>regards,
> >>>
> >>>AJ
> >>>
> >>>
> >
> >>
>
> >
>
------------------------------------
SPAM IS PROHIBITEDYahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/belajar-access/
<*> Your email settings:
Individual Email | Traditional
<*> To change settings online go to:
http://groups.yahoo.com/group/belajar-access/join
(Yahoo! ID required)
<*> To change settings via email:
belajar-access-digest@yahoogroups.com
belajar-access-fullfeatured@yahoogroups.com
<*> To unsubscribe from this group, send an email to:
belajar-access-unsubscribe@yahoogroups.com
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
No comments:
Post a Comment