How to addcontrol in form of another mdb

How to addcontrol in form of another mdb
This function is very simple for insert a command button with Event Procedure
in form any mdb (microsoft access)
This function coding by VBA and can work in VB
Please remember this library must be import to project first
“Microsoft Access 10.0 Libraries” or heigher

Function AddCtl(dbPathAndName As String, frmName As String, OName As String, NName As String)
Dim acc As Access.Application ‘ Destination of microsoft access database (mdb)
Dim frm As Form ‘ object form variable
Dim ctlO As Control ‘ object old control in that form variable (static point to reference by a new control)
Dim ctlN As Control ‘ object new that you will make variable
Dim mdl As Module ‘ object module for place Event Procedure of new control
Dim mdlLine As Long ‘ variable for count of line in module that you start insert a new procedure

‘****************** connect to that database and open destination form in design view ************
Set acc = CreateObject(“access.Application”)
On Error GoTo ExitErr
acc.OpenCurrentDatabase (dbPathAndName)
acc.DoCmd.OpenForm frmName, acDesign

Set frm = acc.Forms(frmmane) ‘ set variables for object form
Set mdl = frm.Module ‘ set variables for object module
Set ctlO = frm.Controls(OName) ‘ set valibles for reference control

‘ create a new control in form, place it in front of old control (or somewhere by reference to old control)
‘ and set it in to new control variable

Set ctlN = acc.CreateControl(frm.Name, acCommandButton, _
acDetail, , , ctlO.Left – (ctlO.Width + 50), ctlO.Top, ctlO.Width, ctlO.Height)

‘ set original properties for new control
ctlN.Name = NName
ctlN.Caption = “Hello!”
ctlN.OnClick = “[Event Procedure]”

‘ create a code “Procedure fon OnClick Event” etc., by “CreateEventProc command
‘ in this step VBA will create start line in some line of module, But we can get a number of line
‘ by itself
mdlLine = mdl.CreateEventProc(“Click”, ctlN.Name)

‘ and the next line from above is a start line of you command
mdl.InsertLines mdlLine + 1, “msgbox ” & Chr(34) & “Hello” & Chr(34)
‘ in anotherway you can in sert a code pattern form a file by method of module
‘ ex. mdl.addfromfile

‘besure close any object
acc.DoCmd.Close acModule, mdl.name , acSaveYes
acc.DoCmd.Close acForm, frm.Name, acSaveYes

Exitt:
acc.CloseCurrentDatabase
Set acc = Nothing
Exit Function

ExitErr:
MsgBox Err.Description
Resume Exitt
End Function

*//one sample for use the function like this : \\*
*\\send values to every variable in function and run //*

Sub runn()

Dim dbPth, frmN, OldN, NewN As String

dbPth = CurrentProject.Path & “\mdbform.mdb”
frmN = “frmtest”
OldN = “cmdExit”
NewN = “cmdTest”

call AddCtl(CStr(dbPth), CStr(frmN), CStr(OldN), CStr(NewN))

End Sub
………………………Gentleman Yeadram ……………………

check exists before ALTER (table, field, references)

Sub main()
Dim conn
Dim sql
Set conn = CurrentProject.Connection

if tbExist(“teacher)=false then

sql = “CREATE TABLE teacher ” & _
“(teacherid varchar(5) NOT NULL, ” & _
“teacher varchar(50) NOT NULL, ” & _
“teacherLastname varchar(30), ” & _
“subjectid char(4) NOT NULL, ” & _
“CONSTRAINT teacher_pk PRIMARY KEY (teacherid), ” & _
“CONSTRAINT teacher_fk FOREIGN KEY (subjectid) ” & _
“REFERENCES subject(subjectid));”

conn.Execute sql

elseif fldExist(“teacher”,”teacherLastName”)=false then

sql=”ALTER TABLE teacher ADD teacherLastName varchar(30);”
conn.Execute sql

end if
set conn=nothing

End Sub
‘——————————————————————————–

Function fldExist(ByVal tbN As String, ByVal fldN As String) As Boolean
Dim Rss As New ADODB.Recordset
Rss.Open tbN, CurrentProject.Connection, 1
Dim i As Long
For i = 0 To Rss.Fields.Count – 1
If Rss(i).NAME = fldN Then
fldExist = True
Exit Function
End If
Next
fldExist = False
End Function
‘——————————————————————————–

Function tbExist(ByVal tbN As String) As Boolean
Dim Rss As New ADODB.Recordset
Rss.Open “Select name from MsysObjects”, CurrentProject.Connection, 1
Do While Not (Rss.EOF)
If Rss(0) = tbN Then
tbExist = True
Exit Function
End If
Rss.MoveNext
Loop
tbExist = False
End Function

ตอบคำถาม ไว้ที่ :http://access.crtrading.net/webboard/view.aspx?id=173
นามสมมติ : GTM

Manage DBF by VBA

Manage DBF by VBA
For some DBF that no have index table (FPT, TBK, CDX , etc.)
I just do anything by Link it into MDB and manage..

And for DBF that come with index table I can not link it into MDB first,
But we can open it by MS EXCEL and save as to another name.
And now we can link it into MDB and can manage them.
In this case I have writen a function like this..

_______________________________________________________________________________________________________
Function Cust_Prod(tbPATH As String, tbNAME As String)
Dim Ex As Excel.Application
Set Ex = CreateObject(“Excel.Application”)
On Error Resume Next
‘Ex.Visible = True
Ex.Workbooks.Open tbPATH & tbNAME & “.DBF”
Ex.ActiveWorkbook.SaveCopyAs tbPATH & “A” & Right(tbNAME, Len(tbNAME) – 1) & “.DBF”
Ex.ActiveWorkbook.CLOSE
Ex.Application.Quit
Set Ex = Nothing
End Function

_______________________________________________________________________________________________________

However, That way not realy work for us because the another name I’d mean to another file not original DBF
So we can read it only

And then I have found the way, I just connect DBF (come with index tables) by OLEDB
First we must download and register one DLL file like VFPOLE.dll (You can find it for free in internet)
And Just copy this to your new module. I hope every one can call my function. ^_^

Global Conn As New ADODB.Connection
Global Rs As New ADODB.Recordset
Global i As Integer
Global j As Long
Global sql As String

‘_______________________________________________________________________________________________________
Function oConn(ByVal pth As String)
On Error GoTo errExit
If Conn.State 0 Then Conn.Close
Conn.Open (“Provider=VFPOLEDB.1;Data Source=” & pth & “;Mode=ReadWrite|” _
& “Share Deny Read|Share Deny Write;Extended Properties=””;User ID=””;Password=””;” _
& “Mask Password=False;Cache Authentication=False;Encrypt Password=False;” _
& “Collating Sequence=MACHINE;DSN=”””)
Exit Function
errExit:
MsgBox Err.Number & ” : ” & Err.Description
End Function

‘_______________________________________________________________________________________________________
Function cConn()
If Rs.State 0 Then Rs.Close
If Conn.State 0 Then Conn.Close
End Function

Random Show a fews fields (columns) on a fews Records (Rows) by VBA code in ms Access

Sub main()
Dim rndRec
Dim rndFld
Dim CntRec
Dim CntFld
Dim arRec()
Dim arFld()
Dim x, y
rndRec = (Rnd \ 1) + 2
rndFld = (Rnd \ 1) + 2
ReDim arRec(rndRec)
ReDim arFld(rndFld)
 
Dim rs ‘ as new adodb.recordset
Dim Conn ‘ as new adodb.connection
Set Conn = CurrentProject.Connection
 
sql = “Select * From table1;”
rs.Open sql, Conn, 1, 1
rs.MoveLast
CntFld = rs.Fields.COUNT – 1
CntRec = rs.RecordCount – 1
 
For x = 1 To rndRec
arRec(x – 1) = CntRec * Rnd \ 1
        For y = 0 To x
        If arRec(x – 1) = arRec(y) Then arRec(x – 1) = CntRec * Rnd \ 1
        Next
Next
 
For x = 1 To rndFld
arFld(x – 1) = CntFld * Rnd \ 1
        For y = 0 To x
        If arFld(x – 1) = arFld(y) Then arFld(x – 1) = CntFld * Rnd \ 1
        Next
Next
 
Dim strAns
strAns = “”
For x = 0 To rndRec – 1
rs.MoveFirst
        Do While Not rs.EOF
        If rs.AbsolutePosition = arRec(x) Then
        strAns = strAns & “Record No : ” & rs.AbsolutePosition & vbCrLf
        For y = 0 To rndFld – 1
        strAns = strAns & ”     Field No : ” & arFld(y) & ”   Field Name : ” & rs(arFld(y)).NAME & _
        ”   Field Value : ” & rs(arFld(y)) & vbCrLf
        Next
        End If
        rs.MoveNext
        Loop
Next
rs.CLOSE
 
Debug.Print strAns
 
End Sub
 
 
……………………………..
ตอบคำถาม ไว้ที่ http://www.thaicreate.com/index.php?modules=forum/?langkey=2
กระทู้หมายเลข :16733   นามสมมติ : GTM

 

 

 

Auto link table in MDB using VBA (With Password)

For every link table on your MDB, when you need to change path to link
this is simple VBA function for working, place this code into your module (some old or new)
(on front-end mdb or adp)

 Read my advice “How to use this function”

”*****Module:****

Function Linkdatabase(ByVal LinkFile As String, Optional pw = “”, Optional Alltb = True)
Dim cnn As New ADODB.Connection
Dim Rss As New ADODB.Recordset
Dim sq As String
Set cnn = Application.CurrentProject.Connection

If pw <> “” And InStr(1, LCase(pw), “access”) = 0 Then pw = “MS Acess;PWD=” & pw & “;”

If Alltb = False Then
sq = “SELECT * FROM LinkTable”
Else
sq = “SELECT NAME FROM MsysObjects WHERE ([TYPE]=6)”
End If

Dim dbs As dao.Database
Dim tb As dao.TableDef
Dim j As Long
    If Rss.State = 1 Then Rss.Close
    Rss.Open sq, cnn, 1
    j = Rss.RecordCount
    Do While j <> 0
    sq = Rss(0)
    j = j – 1
    If tbExist(Rss(0)) Then DoCmd.DeleteObject acTable, Rss(0)
    If pw <> “” Then
        Set dbs = DBEngine.Workspaces(0).OpenDatabase(LinkFile, False, False, pw)
            For Each tb In dbs.TableDefs
            If tb.Name = sq Then DoCmd.TransferDatabase acLink, “Microsoft Access”, _
            LinkFile, acTable, sq, sq, False, True
            Next
        dbs.Close
        Set dbs = Nothing
    Else
    DoCmd.TransferDatabase acLink, “Microsoft Access”, LinkFile, acTable, sq, sq, False
    End If
    Rss.MoveNext
   
    Loop
   
    Rss.Close
    Set Rss = Nothing
    Set cnn = Nothing

End Function

‘*****End Module:****

 

the function “tbExist” that included is a function I post on first post if you not yet read it please follow this https://yeadram.wordpress.com/check exists before alter table field/

 

Multi-style to use this function

By Macro Autoexec  if your want to MDB ask every time yor start the program

by Command button  Let this function can called by any command button

Link some table(s)    if you want to re-link for some tables (Not all)

&npsp;

use auto Macro

– take create macro name = “autoexec”
– use the command          = “runcode”
– argument name of function = ChangeDatabase
– save and close the macro (besure name of macro is “autoexec”)
– copy below function into your module (some old or new)

 

Function ChangeDatabase()
Dim sq As String
Dim pw As String
Dim msg As String
Dim LinkFile As String
Dim aTb As Boolean

LinkFile = DLookup(“Database”, “MsysObjects”, “[TYPE] = 6”)
pw = Nz(DLookup(“Connect”, “MsysObjects”, “[TYPE] = 6”), “”)
If InStr(1, pw, “PWD”) > 0 Then
msg = LinkFile & “-With Password!”
Else
msg = LinkFile
End If

sq = InputBox(“Your current path is” & vbCrLf & msg & _
vbCrLf & “If you need to change path please retype then press OK button” & _
vbCrLf & “if The ‘destination MDB’ have a password ….” & _
vbCrLf & “input ‘-[your password]’ after path”, “Confirm path of your data”, msg)
If IsNull(sq) Or IsEmpty(sq) Or sq = ” ” Then Exit Function

If tbExist(“LinkTable”) Then
Select Case MsgBox(“Do you want re-link only table’s name in ‘LinkTable’?” & vbCrLf & _
“… if you said ‘No’ it will re-link All tables …”, vbQuestion + vbYesNoCancel, “How many tables”)
Case vbYes
aTb = True
Case vbNo
aTb = False
Case Else
Exit Function
End Select
End IF

If InStr(1, sq, “-“) > 0 Then
Dim ar() As String
ar = Split(sq, “-“, , vbTextCompare)
    If ar(0) <> LinkFile Then
    LinkFile = ar(0)
        If ar(1) = “With Password!” Then
        Linkdatabase LinkFile, pw, aTb
        Else
        Linkdatabase LinkFile, “MS Acess;PWD=” & ar(1) & “;”, aTb
        End If
    End If
Else
    If sq <> LinkFile Then
    LinkFile = sq
    Linkdatabase LinkFile, “”, aTb
    End If
End If
End Function

 

Use by Command button

you can call this function from any forms by this syntax
– Call LinkDatabase [path and name destination MDB],[Option Password],[Option AllTable]

 

Link some table(s)

 create table one field
table name =”LinkTable”
field DataTye =”text”
field DataWidth=50
field Name = (any word)

– Input name of tables that you want to re-link
– one name per one record
– and then
if you use by command button Besure the third argument is ‘FALSE’
but if use by macro don’t warry

 

 

…………………………….