problemer med propbag

det her virker i så fald..


Option Explicit

'Default Property Values:
Const m_def_QueryNavn    As String = ""
Const m_def_ServerNavn  As String = ""
Const m_def_DatabaseNavn As String = ""

'Property Variables:
Private m_QueryNavn    As String
Private m_ServerNavn  As String
Private m_DatabaseNavn As String

Public Property Get QueryNavn() As String
  QueryNavn = m_QueryNavn
End Property

Public Property Let QueryNavn(ByVal strValue As String)
  m_QueryNavn = strValue
  PropertyChanged "QueryNavn"
End Property

Public Property Get ServerNavn() As String
  ServerNavn = m_ServerNavn
End Property

Public Property Let ServerNavn(ByVal strValue As String)
  m_ServerNavn = strValue
  PropertyChanged "ServerNavn"
End Property

Public Property Get DatabaseNavn() As String
  DatabaseNavn = m_DatabaseNavn
End Property

Public Property Let DatabaseNavn(ByVal strValue As String)
  m_DatabaseNavn = strValue
  PropertyChanged "DatabaseNavn"
End Property

Private Sub UserControl_InitProperties()
  m_QueryNavn = m_def_QueryNavn
  m_ServerNavn = m_def_ServerNavn
  m_DatabaseNavn = m_def_DatabaseNavn
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  m_QueryNavn = PropBag.ReadProperty("QueryNavn", m_def_QueryNavn)
  m_ServerNavn = PropBag.ReadProperty("ServerNavn", m_def_ServerNavn)
  m_DatabaseNavn = PropBag.ReadProperty("DatabaseNavn", m_def_DatabaseNavn)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Call PropBag.WriteProperty("QueryNavn", m_QueryNavn, m_def_QueryNavn)
  Call PropBag.WriteProperty("ServerNavn", m_ServerNavn, m_def_ServerNavn)
  Call PropBag.WriteProperty("DatabaseNavn", m_DatabaseNavn, m_def_DatabaseNavn)
End Sub

tror det er fordi du dimer (dim) samme navn som funktion navn.. det kan man ikke.. :D

Dim ServerNavn

Public Property Get ServerNavn() As String
  ServerNavn = m_ServerNavn
End Property
....

hmm nu er jeg nået hertil, men m_ServerNavn, m_QueryNavn, m_DatabaseNavn er stadigvæk tomme ? jeg er helt tom for idéer ?

Option Explicit
Dim Kol As Integer ' Antal kolonner
Dim raek As Integer ' Antal rækker

    Dim Con As New ADODB.Connection
    Dim Query1 As New ADODB.Recordset
    Dim fld As ADODB.Field
   
Dim Query As String
'Property Variables
Private m_ServerNavn    As String
Private m_QueryNavn    As String
Private m_DatabaseNavn As String

'Default Property Values:
Const m_def_QueryNavn    As String = ""
Const m_def_ServerNavn  As String = ""
Const m_def_DatabaseNavn As String = ""
Public Property Get QueryNavn() As String

  QueryNavn = m_QueryNavn
End Property

Public Property Let QueryNavn(ByVal strValue As String)
  m_QueryNavn = strValue
  PropertyChanged "QueryNavn"
End Property

Public Property Get ServerNavn() As String
  ServerNavn = m_ServerNavn
End Property

Public Property Let ServerNavn(ByVal strValue As String)
  m_ServerNavn = strValue
  PropertyChanged "ServerNavn"
End Property

Public Property Get DatabaseNavn() As String
  DatabaseNavn = m_DatabaseNavn
End Property

Public Property Let DatabaseNavn(ByVal strValue As String)
  m_DatabaseNavn = strValue
  PropertyChanged "DatabaseNavn"
End Property
Public Sub forbind()
  'On Error GoTo errh

MsgBox m_ServerNavn & ServerNavn
If ServerNavn = "" Or DatabaseNavn = "" Or QueryNavn = "" Then

Exit Sub
Else

Con.ConnectionString = "Provider=sqloledb;Data Source=" & ServerNavn & ";Initial Catalog=" & DatabaseNavn & ";User Id=erg;Password=erg;"
Con.Open
End If

Exit Sub
errh:
   
    MsgBox "Fejl Ved forbindelse" & vbNewLine & Err.Description

End Sub

Private Sub UserControl_Initialize()
'On Error GoTo errh:

    'MsgBox "server: " & Server & vbNewLine & "DataBase: " & Database & vbNewLine & "Query: " & Query ' ConnectionString
    forbind ' Forbinde til SQL database
    ' If Con.State = 0 Then
      If True Then
     
        Debug.Print "Forbindelse ikke oprettet"
        Debug.Print "server: " & ServerNavn
        Debug.Print "Databse: " & DatabaseNavn
        Debug.Print "String: " & QueryNavn
   
    Else
   
    Set Query1 = Con.Execute(Query)
   
   
    ' Henter de Forskellige kolonner
    Kol = 0
   
    'Resætter position i Grid
 
    Grid1.FixedRows = 1
    Grid1.FixedCols = 0
   
    Grid1.Row = 1
    Grid1.Col = 1
   
    Grid1.Cols = 0
    Grid1.Rows = 1
   
    ' Sætter overskrifen på de forskellige kolonner :)
    For Each fld In Query1.Fields
     
        Grid1.Cols = Grid1.Cols + 1
        Grid1.Text = fld.Name
      ' Grid1.Col = 1
       
        Dim COLPOS As Integer
        COLPOS = Grid1.Cols - 1
        Grid1.Col = COLPOS
       
        Kol = Kol + 1
   
    Next fld
    Grid1.Cols = Grid1.Cols - 1
   
'' Dannelse af additem string..
Dim I1 As Integer
Dim AddString As String
AddString = ""
I1 = 0

For I1 = 1 To Kol - 1

    If I1 = 1 Then
      AddString = Query1.Fields(I1)
          Else
      AddString = AddString & vbTab & Query1.Fields(I1)
    End If

Next

Do While Not Query1.EOF

        Grid1.AddItem (AddString)
        'Grid1.Rows = Grid1.Rows + 1 ' Laver en Række til hentet data :)
       
        Query1.MoveNext ' Næste id
    Loop
    Con.Close

    End If
   
Exit Sub

errh:
    MsgBox "Fejl:" & vbNewLine & Err.Description
   
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  m_QueryNavn = PropBag.ReadProperty("QueryNavn", m_def_QueryNavn)
  m_ServerNavn = PropBag.ReadProperty("ServerNavn", m_def_ServerNavn)
  m_DatabaseNavn = PropBag.ReadProperty("DatabaseNavn", m_def_DatabaseNavn)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Call PropBag.WriteProperty("QueryNavn", m_QueryNavn, m_def_QueryNavn)
  Call PropBag.WriteProperty("ServerNavn", m_ServerNavn, m_def_ServerNavn)
  Call PropBag.WriteProperty("DatabaseNavn", m_DatabaseNavn, m_def_DatabaseNavn)
End Sub

du kan ikke læse dem under UserControl_Initialize()


Private Sub UserControl_Paint()
  Debug.Print "server: " & ServerNavn
  Debug.Print "Databse: " & DatabaseNavn
  Debug.Print "String: " & QueryNavn
End Sub

Private Sub UserControl_Show()
  Debug.Print "server: " & ServerNavn
  Debug.Print "Databse: " & DatabaseNavn
  Debug.Print "String: " & QueryNavn
End Sub

mange tak for hjælpen :) det virker nu