---

Hallo zusammen!

Ich habe mir vor längerer Zeit ein kleines Tool unter VBA geschrieben, in dem ich Dateien in ein bestimmtes Verzeichnis konvertiere:

C:\ww4\dxf

Wichtig ist der Ordner \dxf. Dieser kann sich aber auf anderen Rechnern in einem ganz anderen Verzeichnis befinden.
Über den Ordnerauswahldialog kann man zwar ein neues Verzeichnis auswählen aber es nicht in eine Textbox speichern, so daß dieser beim nächsten Programmstart auch wieder angezeigt wird.
Ich hatte da schon mal im Forum nachgefragt und da kam der Hinweis bzgl. einer eigenen INI-Datei um den Pfad entsprechend zu speichern.

Könnte mir dabei jemand helfen, da ich überhaupt nicht weiß, wie ich da anfangen soll.

Die INI-Datei soll cnc.ini lauten.

Hier ein Auszug aus meinem Programm:

Code:

---

Private Const MAX_PATH = 260
'*********************************************************
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
'*********************************************************
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_STATUSTEXT = &H4
'*********************************************************
Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
  (ByVal hMem As Long)
'*********************************************************
Private Declare Function lstrcat Lib "kernel32" Alias _
  "lstrcatA" (ByVal lpString1 As String, _
  ByVal lpString2 As String) As Long
'*********************************************************
Private Declare Function GetActiveWindow Lib "user32" () _
  As Long
'*********************************************************
Private Declare Function SHGetPathFromIDList Lib "shell32" _
  (ByVal pidList As Long, ByVal lpBuffer As String) As Long
'********************************************************
Private Declare Function SHBrowseForFolder Lib "shell32" _
  (lpbi As BrowseInfo) As Long
'*********************************************************
Public Function BrowseForFolder(Prompt As String) As String
    Dim n As Integer
    Dim IDList As Long
    Dim Result As Long
    Dim ThePath As String
    Dim BI As BrowseInfo
    With BI
        .hWndOwner = GetActiveWindow()
        .lpszTitle = lstrcat(Prompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    IDList = SHBrowseForFolder(BI)
If IDList Then
    ThePath = String$(MAX_PATH, 260)
    Result = SHGetPathFromIDList(IDList, ThePath)
    Call CoTaskMemFree(IDList)
    n = InStr(ThePath, vbNullChar)
    If n Then ThePath = Left$(ThePath, n - 1)
End If
    BrowseForFolder = ThePath
End Function

...
...

Private Sub cmd4_Click()
Dim objDxf As AcadSelectionSet
Dim strTempName As String
Dim strTempPath As String
Dim strFilename As String
Dim objExportFile As AcadDocument
UserForm1.Hide

Select Case Cbo.ListIndex

Case 0  'Abspeichern des WBloks unter R 12.dxf

'strTempPath = ThisDrawing.path & "\" & tbo1.Text
strTempPath = tbo.Text & "\" & tbo1.Text

strFilename = RemoveExtension(ThisDrawing.name)
Set objDxf = ThisDrawing.SelectionSets.Add("dxfcnc"): objDxf.SelectOnScreen
ThisDrawing.Wblock strTempPath, objDxf
Set objExportFile = ThisDrawing.Application.Documents.Open(strTempPath)
With objExportFile
.SaveAs ThisDrawing.path & "\" & tbo1.Text, acR12_dxf
.Close
End With
Kill strTempPath & ".dwg"
'Kill strTempPath 'delete temp. Wblock.dwg File
strTempPath = RemoveExtension(strTempPath)
objDxf.Delete
Set objDxf = Nothing
Set objExportFile = Nothing
UserForm1.Show

Case 1  'Abspeichern des WBloks unter R 13.dxf

strTempPath = ThisDrawing.path & "\" & tbo1.Text
'strTempPath = ThisDrawing.path & "\tmpDxfOut.dwg"
strFilename = RemoveExtension(ThisDrawing.name)
Set objDxf = ThisDrawing.SelectionSets.Add("dxfcnc"): objDxf.SelectOnScreen
ThisDrawing.Wblock strTempPath, objDxf
Set objExportFile = ThisDrawing.Application.Documents.Open(strTempPath)
With objExportFile
'.SaveAs ThisDrawing.path & "\" & strFilename, acR13_dxf
.SaveAs ThisDrawing.path & "\" & tbo1.Text, acR13_dxf
.Close
End With
Kill strTempPath & ".dwg"
'Kill strTempPath 'delete temp. Wblock.dwg File
strTempPath = RemoveExtension(strTempPath)
objDxf.Delete
Set objDxf = Nothing
Set objExportFile = Nothing
UserForm1.Show

Case 2  'Abspeichern des WBloks unter R 14.dxf

strTempPath = ThisDrawing.path & "\" & tbo1.Text
'strTempPath = ThisDrawing.path & "\tmpDxfOut.dwg"
strFilename = RemoveExtension(ThisDrawing.name)
Set objDxf = ThisDrawing.SelectionSets.Add("dxfcnc"): objDxf.SelectOnScreen
ThisDrawing.Wblock strTempPath, objDxf
Set objExportFile = ThisDrawing.Application.Documents.Open(strTempPath)
With objExportFile
'.SaveAs ThisDrawing.path & "\" & strFilename, acR14_dxf
.SaveAs ThisDrawing.path & "\" & tbo1.Text, acR14_dxf
.Close
End With
Kill strTempPath & ".dwg"
'Kill strTempPath 'delete temp. Wblock.dwg File
strTempPath = RemoveExtension(strTempPath)
objDxf.Delete
Set objDxf = Nothing
Set objExportFile = Nothing
UserForm1.Show

End Select
End Sub

Public Function RemoveExtension(FileName1 As String) As String
RemoveExtension = Left(FileName1, Len(FileName1) - 4)
End Function

Private Sub cmd6_Click()
    ThePath = BrowseForFolder("Wählen Sie einen Ordner aus")
    If ThePath <> "" Then 'wenn Rückgabewert nicht leer dann
    Text1.Text = ThePath '& "/" & newname 'alternativ falls Backslash fehlt:
    End If
End Sub

Private Sub UserForm_Initialize()
UserForm1.tbo.Text = "C:\ww4\dxf"
StatusBar1.Panels(1).Text = "aktueller Zeichnungsname = " & ThisDrawing.name

Cbo.Value = "R12 - DXF"

With Cbo
    .AddItem "R12 - DXF", 0
    .AddItem "R13 - DXF", 1
    .AddItem "R14 - DXF", 2
End With
     
End Sub
Private Sub Cmd1_click()
    End
End Sub

---

Für Hilfe wäre ich wie immer sehr dankbar.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

Verstehe ich es richtig, das du den letzten gewählten Pfad in deiner Auswahlbox der Pfad stehen haben willst, oder ist das je Rechner eine einmalige Angelegenheit?!
Wenn due nur den letzten gewählten Pfad in der Box beim Aufrufen haben willst würde ich den Pfad in einen Registrierungsschlüssel speichern und beim nächsten Mal diesen Schlüssel wieder auslesen.
Du hast ausserdem eine PM von mir.

Gruß, Carsten.

[Diese Nachricht wurde von Carsten1210 am 03. Okt. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Carsten!

Genau!
Es würde mir reichen, wenn der zuletzt aufgerufen Pfad in der TBox erscheinen würde.
Nur wie speicher ich diesen in einem Registrierungsschlüssel ab bzw. lese diesen wieder aus?

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Drik,

Guckst du hier  .

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Carsten!

Wenn ich ehrlich bin, komme ich damit nicht klar.
Es soll ein Eintrag in die Registrie geschrieben werden, z.B.:

1. linke Baumstruktur:
HKEY_CURRENT_USER\Software\Autodesk\DB_Tuning\CNC

2. rechts
Name / Typ / Wert (C:\ww4\dxf = aus der TextBox)

Der gespeicherte Wert wird dann beim Neustart des Programms wieder ausgelesen.

Für weitere Hilfe schon mal vielen Dank im voraus.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

Probier folgendes:

Public Sub reglesen()
Dim regpfad As String
Dim Wert As String
regpfad = "HKEY_CURRENT_USER\Software\Autodesk\DB_Tuning\CNC"
Wert = RegRead(regpfad)
MsgBox Wert
End Sub
Public Sub regschreiben()
Dim regpfad As String
Dim Wert As String
Dim a
regpfad = "HKEY_CURRENT_USER\Software\Autodesk\DB_Tuning\CNC"
Wert = "C:\ww4\dxf"
a = RegWrite(regpfad, Wert, "REG_SZ")
End Sub
Public Function RegRead(Path As String) As String
  Dim ws As Object

  On Error GoTo ErrHandler
  Set ws = CreateObject("WScript.Shell")
  RegRead = ws.RegRead(Path)
  Exit Function

ErrHandler:
  RegRead = ""
End Function
Public Function RegWrite(ByVal Path As String, _
  ByVal Value As String, _
  Optional ByVal Typ As String = "REG_SZ") As Boolean

  Dim ws As Object

  On Error GoTo ErrHandler
  Set ws = CreateObject("WScript.Shell")
  ws.RegWrite Path, Value, Typ
  RegWrite = True
  Exit Function

ErrHandler:
  RegWrite = False
End Function

Und grüß den Rolf Stratmann mal von mir. 

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Carsten!

Vielen Dank für die Hilfe.
Nach erstem testen funktionierts sehr gut.

Code:

---

Public Function RegRead(Path As String) As String
  Dim ws As Object

  On Error GoTo ErrHandler
  Set ws = CreateObject("WScript.Shell")
  RegRead = ws.RegRead(Path)
  Exit Function

ErrHandler:
  RegRead = ""
End Function
Public Function RegWrite(ByVal Path As String, _
  ByVal Value As String, _
  Optional ByVal Typ As String = "REG_SZ") As Boolean

  Dim ws As Object

  On Error GoTo ErrHandler
  Set ws = CreateObject("WScript.Shell")
  ws.RegWrite Path, Value, Typ
  RegWrite = True
  Exit Function

ErrHandler:
  RegWrite = False
End Function
...
...
...
Public Sub UserForm_Initialize()
Dim regpfad As String
Dim Wert As String
regpfad = "HKEY_CURRENT_USER\Software\Autodesk\DB_Tuning\CNC"
UserForm1.tbo.Text = RegRead(regpfad)
StatusBar1.Panels(1).Text = "aktueller Zeichnungsname = " & ThisDrawing.name
Cbo.Value = "R2004 - DXF"
With Cbo
    .AddItem "R2004 - DXF", 0
    .AddItem "R14 - DXF", 1
End With
End Sub

Public Sub cmd6_Click()
Dim regpfad As String
Dim Wert As String
Dim a
regpfad = "HKEY_CURRENT_USER\Software\Autodesk\DB_Tuning\CNC"
Wert = tbo.Text
a = RegWrite(regpfad, Wert, "REG_SZ")
    End
End Sub

---

Woher kennst Du denn Rolf Stratmann?

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Dirk,

Frag ihn doch einfach Mal. 

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

falls doch lieber in Ini-Datei speichern, gibt es hier einen guten Workshop zu dem Thema:
http://www.vbarchiv.net/workshop/workshop17.php

MfG

Marco Schreiter

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Marco!

Vielen Dank für die Info.
Ich werde dieses mal probieren.

Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

in VBA gibt es auch die einfache Variante

Code:

---

SaveSetting "IS_VBA_TOOL", "Startup", "MDB", Me.txt_VorlageMDB.Text
bzw.
tmp = GetSetting("IS_VBA_TOOL", "Startup", "WIEDERHOLEN", 1)

---

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP