INI in Excel importieren

[=BT=Viper 11]

Hi, ich möchte eine INI Datei in Excel importieren.

 

[Name1]

Variable1=Wert1

Variable2=Wert2

...

...

[Name2]

Variable1=Wert1

Variable2=Wert2

...

...

 

Bei einem Standart Import stehen natürlich [Name1], Variable1 und Variable2 in Spalte A und die Werte in Spalte B.

 

Jetzt hätte ich gerne einen Import, der mir [Name] in Spalte A, Variable1 in Spalte B, Variable2 in Spalte C, usw. setzt und die Werte in die ensprechenden Spalten einträgt.

Muss ich das per Makro realisieren oder geht das auch anders?

Ich hab mich bisher leider wenig mit Makros beschaäftigt und etwas Hilfe wäre echt super!

[kurisa 10]

die betroffenen zeilen/spalten markieren - kopieren - neuen bereich auswählen und per einfügen - inhalt einfügen - die option "transponieren" aktivieren und bestätigen

[=BT=Viper 11]

Hmmmm.....OK das funktioniert schonmal besser so als normales Copy und Paste. THX!

Aber ist schon eine langwierige arbeit. Die INI Datei ist ziemlich gross.

Automatisiert wäre das besser. :(

[=BT=Viper 11]

Hat jemand ein gutes Beispiel Makro für GetINIString?

[cablit 10]

Hi Viper,

 

ich würde dir von einem Makro mit API-Calls abraten ... bastel dir einen neuen Button und hinterlege dort den Code (in dem Beispiel Call fctGetIniString --> Wobei die Funktion eben [wie der Name schon vermuten lässt] den INI-String zurückliefert und du diesen dann weiter verarbeiten musst)...

 

Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Function fctGetIniString(sFileName As String, sSection As String, sKey As String) As String
Dim sBuffer As String 'To hold the returned value
Dim lSize As Long 'Max size of sBuffer
Dim lReturn As Long
lSize = 256

' Fill the sBuffer string with nulls
sBuffer = String(lSize, vbNullChar)
lReturn = GetPrivateProfileString(sSection, sKey, "", sBuffer, size - 1, sFileName)
If lReturn > 0 Then
GetIniString = Left(sBuffer, lReturn)
Else
GetIniString = ""
End If
End Function

 

Grüße

[=BT=Viper 11]

Warum keine API-Calls? Ist es damit nicht einfacher? Ich muss ja nicht nur teile sondern alles auslesen.

[cablit 10]

Doch, mit API-Calls ist es einfacher, aber im reinen Code eben ... Makros sind bei API-Calls einfach anfällig (unerklärliche Abstürze oder unerwartetes Verhalten / Ergebnisse). Für einen kompletten Code zum Auslesen der INI und befüllen deines Excel-Sheets bräuchte ich ein paar mehr Angaben und ein bisschen mehr Zeit ;) ... am besten dann über PM.

 

Grüße

[=BT=Viper 11]

Also wenn das makro mal absemmelt macht das nix. Muss nur alle Schlatjahr gemacht werden und verstrubbelt kann nix werden.

 

Hab mal mit deinem Beispiel getesten und immerhin schonmal werte lesen können :)

 

Wenn ich das richtig verstehe, muss ich definieren, welchen Wert in welcher Gruppe er lesen soll.

 

Jedoch muss ich es so machen, daß er beginnt, die erste Gruppe ließt und dann die Werte und Gruppe in die Tabelle packt.

 

Hier mal ein kleiner Teil der INI:

 

[Annihilator ANH-1A]

Weight=100

Tech=IS

Internal=Standard

Engine=Regular

BaseEngineRating=200

LegType=Man 2 segments

TorsoType=Vertical

StockEngineRating=200

JJCapable=0

LAMSCapable=0

ECMCapable=0

BAPCapable=0

IFFCapable=0

EOCapable=0

AGCapable=0

360Capable=0

Legendary=0

ObstructingSection=0

SpeedIncreasesBonus=1

BaseSpeedBonus=0

AccelerationBonus=-1

TurnRateBonus=0

TorsoTwistRadiusBonus=0

TorsoTwistSpeedBonus=0

BaseTonnageBonus=1

InternalHeatSinksBonus=0

 

[Argus AGS-4D]

Weight=60

Tech=IS

Internal=Endo Steel

Engine=XL

BaseEngineRating=255

StockEngineRating=300

LegType=Bird 3 segments

TorsoType=Horizontal

JJCapable=0

LAMSCapable=0

ECMCapable=0

BAPCapable=1

IFFCapable=1

EOCapable=0

AGCapable=0

360Capable=0

Legendary=0

ObstructingSection=0

SpeedIncreasesBonus=-1

BaseSpeedBonus=0

AccelerationBonus=0

TurnRateBonus=1

TorsoTwistRadiusBonus=0

TorsoTwistSpeedBonus=0

BaseTonnageBonus=0

InternalHeatSinksBonus=0

 

Die Ausgabe der Tabelle versuche ich so hin zu bekommen:

 

NAME___________|Weight|Tech|Internal__|...

Annihilator ANH-1A|___100|__IS|Standard_|...

Argus AGS-4D____|____60|_ IS|Endo Steel|...

 

 

Besonders tricky wird es, weil zum Teil die Werte nicht in der selben Reihenfolge stehen. Also muss ich die Gruppe lesen, als Name eintragen, den ersten Key auslesen und ermitteln in welche Spalte der Wert gehört.

*sfz* hätt ich doch nur nicht vor 10 Jahren mit dem proggen aufgehört. :(

[cablit 10]

Hi Viper,

 

ich würde dir ne Funktion schreiben, die die Datei ausliest. Kann ich aber erst heut abend machen. Hoffe, das reicht dir noch.

 

Grüße

[=BT=Viper 11]

Das wär natürlich super! :)

Ein Beispiel für 1-2 Keys incl. Gruppe sollte reicht. Macht ja nur Sinn wenn ich es danach auch blicke ;) Man will ja was dazulernen und nicht doof sterben.

[cablit 10]

Hi Viper,

 

hab mal was geschrieben, das passt bei mir soweit. Den Header also was in Zeile 1 alles steht, füllst du am besten schon vorher aus (NAME___________|Weight|Tech|Internal__|...). Den Code, den ich geschrieben habe, kannst du von einem Makro aus aufrufen, da ist jetzt kein API-Call mehr drin. Den Code selbst fügst du einfach in dein Worksheet ein. (Code im zweiten Posting, da zu lang)

 

Solltest du noch Fragen haben, kannst du sie gern stellen :D

 

Grüße

[cablit 10]

Private Function fctFillTableFromINI()
Dim dlgFileOpen As FileDialog
Dim strFileName As String
Dim strLineInput As String
Dim lngPosRow As Long
Dim lngPosCol As Long
Dim intFN As Integer

On Error GoTo Error_fctFillTableFromINI

   lngPosRow = 2
   lngPosCol = 97
'Dialog zum Datei öffnen anzeigen
   Set dlgFileOpen = Application.FileDialog(msoFileDialogOpen)
   With dlgFileOpen
       .AllowMultiSelect = False
       .ButtonName = "INI-Datei auswählen"
       .Filters.Add "INI-Dateien", "*.ini"
       If .Show = -1 Then
           If .SelectedItems.Count <= 0 Then
               MsgBox "Es wurde keine Datei ausgewählt!", vbInformation + vbOKOnly, "Keine Datei ausgewählt"
               Exit Function
           Else
               strFileName = .SelectedItems
           End If
       End If
   End With
'Dateieinlesen vorbereiten
   intFN = FreeFile
   Open strFileName For Input As intFN
'Datei zeilenweise einlesen und in das Sheet einfügen
   Do While Not EOF(intFN)
       Line Input #intFN, strLineInput
       If Left(strLineInput, 1) = "[" Then
           Range(CStr(Chr(lngPosCol) & lngPosRow)).Select
           ActiveCell.FormulaR1C1 = Mid(strLineInput, 2, Len(strLineInput) - 2)
       ElseIf strLineInput <> "" Then
           Range(CStr(Chr(lngPosCol) & lngPosRow)).Select
           If InStr(1, strLineInput, "Weight") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("Weight = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "Tech") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("Tech = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "Internal") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("Internal = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "BaseEngineRating") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("BaseEngineRating = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "LegType") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("LegType = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "TorsoType") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("TorsoType = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "StockEngineRating") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("StockEngineRating = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "JJCapable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("JJCapable = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "LAMSCapable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("LAMSCapable = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "ECMCapable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("ECMCapable = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "BAPCapable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("BAPCapable = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "IFFCapable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("IFFCapable = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "EOCapable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("EOCapable = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "AGCapable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("AGCapable = ") + 1, Len(strLineInput))

[cablit 10]

Fortsetzung

           If InStr(1, strLineInput, "360 Capable") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("360 Capable = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "Legendary") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("Legendary = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "ObstructingSection") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("ObstructingSection = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "SpeedIncreasesBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("SpeedIncreasesBonus = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "BaseSpeedBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("BaseSpeedBonus = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "AccelerationBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("AccelerationBonus = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "TurnRateBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("TurnRateBonus = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "TorsoTwistRadiusBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("TorsoTwistRadiusBonus = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "TorsoTwistSpeedBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("TorsoTwistSpeedBonus = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "BaseTonnageBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("BaseTonnageBonus = ") + 1, Len(strLineInput))
           If InStr(1, strLineInput, "InternalHeatSinksBonus") > 0 Then ActiveCell.FormulaR1C1 = Mid(strLineInput, Len("InternalHeatSinksBonus = ") + 1, Len(strLineInput))
       End If

       lngPosCol = lngPosCol
       lngPosRow = lngPosRow
   Loop

'Datei schließen
   Close intFN

'Erfolgsmeldung
   MsgBox "Import abgeschlossen", vbInformation + vbOKOnly

'Fehlerbehandlung
Exit_fctFillTableFromINI:
   Exit Function

Error_fctFillTableFromINI:
   MsgBox "Es ist folgender Fehler (Nr: " & Err.Number & ") aufgetreten." & vbCrLf & vbCrLf & Err.Description
   Err.Clear
   Resume Exit_fctFillTableFromINI

End Function

[=BT=Viper 11]

Super! Hab schon damit rumgespielt und es klappt bis auf ein paar kleine kniffe noch. Hab dir mal ne PM geschickt.

[cablit 10]

Hi Viper,

 

freut mich, dass es passt. Die PM ist leider nicht angekommen?!

 

Grüße