Springen naar inhoud


- - - - -
VB6

Een Routine Probleem



  • Log in a.u.b. om te beantwoorden
Er zijn 4 reacties in dit onderwerp

#1 Marc Devlieger

Marc Devlieger

    Starting Developer

  • Leden
  • 13 berichten
    Laatst bezocht 05 mei 2015 17:51

Geplaatst op 02 februari 2015 - 16:42

Hoi,

Ik heb hier een progje om een Excelbestand in te lezen in een Accessbestand. Eerst controleert VB of de veldnamen Access / Excel identitiek zijn, nadien wordt overgegaan tot export.

Het lukt mij enkel om 1 COL te exporteren 'via ZB = 2' (tweede ROW)

Waar moet ik mijn FOR TELLER C plaatsen om alle ROWS en COLS te exporteren.

Marc dv



Module_08.Openen_XLS_Bestand

For TellerA = 0 To Form_03.CMBMap.ListCount - 1

For TellerB = 0 To Form_00.LSTMap.ListCount - 1

ZA = Len(Form_00.LSTMap.List(TellerB))
If Left(Form_03.CMBMap.List(TellerA), ZA) = Form_00.LSTMap.List(TellerB) Then

Set xLSheet = xLApp.Application.ActiveWorkbook.Sheets("" & Form_03.CMBMap.List(TellerA) & "")

X = xLSheet.UsedRange.Columns.Count
Y = xLSheet.UsedRange.Rows.Count

ZB = 2

TekstB = Form_00.LSTImport_Database.List(TellerB)

StrQuery = Query_001 & " Postprocessing WHERE Database='" & TekstB & "'"
Module_05.Uitvoer_CommObsCompare_database

RsADO_CommObsCompare.MoveFirst

StrQuery = Query_001 & " " & TekstB
Module_06.Uitvoer_Project_database

RsADO_Project.AddNew

'For TellerC = 2 To Y

For TellerD = 1 To RsADO_CommObsCompare.RecordCount

For TellerE = 1 To X

If xLSheet.Cells(1, TellerE) = RsADO_CommObsCompare!Post_Item Then

TekstC = RsADO_CommObsCompare!Project_Item
RsADO_Project.Fields(TekstC) = xLSheet.Cells(ZB, TellerE)
RsADO_Project.Update

End If

Next TellerE

RsADO_CommObsCompare.MoveNext

Next TellerD

'ZB = ZB+1
'Next TellerC

RsADO_CommObsCompare.Close

RsADO_Project.Close

Form_00.LSTTEST.AddItem TekstB
Form_00.LSTTEST.AddItem X
Form_00.LSTTEST.AddItem Y

End If

Next TellerB

Next TellerA

Module_08.Sluiten_XLS_bestand

#2 tromt

tromt

    Professional Developer

  • Leden
  • PipPipPipPip
  • 305 berichten
    Laatst bezocht 03 aug 2020 13:32
  • LocatieRijen (NB)

Geplaatst op 02 februari 2015 - 18:21

Oef, VB6 , das lang geleden.
Ik heb even gekeken in heel oude stuf en iets gevonden. Hoop dat je er wat aan hebt.
Code:
 
Function fnLeesExcel(sFF As String) As String
  Dim L As Integer, M As Integer, leeg As Boolean							  'om for-next lusjes mee te maken
  Dim R As Integer, C As Integer, iRows As Integer, iCols As Integer		   '(hulp)variabelen voor rijen en kolommen
  Dim sV() As String, sL() As String, S As String							  'sV voor de velden en sR voor de regels en S als separator
  Dim AppExcel As Excel.Application											'dim object excel early binding
  S = Chr(34) & Chr(44) & Chr(34)
  Set AppExcel = New Excel.Application
  AppExcel.Application.Workbooks.Open sFF											'gevonden bestand openen
  R = 1: C = 1
  Do While AppExcel.Cells(R, C) <> "": C = C + 1: Loop: iCols = C - 1				'kolommen tellen
  Do Until leeg = True
	If AppExcel.Cells(R, 1) <> "" Or AppExcel.Cells(R, 2) <> "" Then
	  R = R + 1: leeg = False
	Else
	  leeg = True
	End If
  Loop
  iRows = R - 1
 
  ReDim sV(iCols)
  ReDim sR(iRows)
 
  For L = 1 To iRows
	For M = 1 To iCols: sV(M) = AppExcel.Cells(L, M).Value: Next: sR(L) = Join(sV, S) & Chr(34)
	sR(L) = Right(sR(L), Len(sR(L)) - 2)									 'hij zet ook voor het eerste veld een S, daar moet een stukje af
  Next
  fnLeesExcel = Join(sR, vbCrLf)
  If fnLeesExcel = "" Then
	fnLeesExcel = "leeg"
  Else
	fnLeesExcel = Right(fnLeesExcel, Len(fnLeesExcel) - 2)				   'hij begint met een linefeed, die moet eraf
  End If
  AppExcel.Quit
  Set AppExcel = Nothing
End Function



#3 Marc Devlieger

Marc Devlieger

    Starting Developer

  • Leden
  • 13 berichten
    Laatst bezocht 05 mei 2015 17:51

Geplaatst op 02 februari 2015 - 18:41

mogelijk om mijn lus te controleren op eigen code ? Vermoedelijk een kleinigheid maar vind het niet.

#4 Marc Devlieger

Marc Devlieger

    Starting Developer

  • Leden
  • 13 berichten
    Laatst bezocht 05 mei 2015 17:51

Geplaatst op 02 februari 2015 - 19:17

Als ik mijn lus tellerC plaats, dan krijg ik enkele mijn laatste lijn gegevens van het EXCEL sheet.

For TellerD = 1 To RsADO_CommObsCompare.RecordCount

                            For TellerE = 1 To X

                                If xLSheet.Cells(1, TellerE) = RsADO_CommObsCompare!Post_Item Then

                                    For TellerC = 2 To Y
                                    TekstC = RsADO_CommObsCompare!Project_Item
                                    RsADO_Project.Fields(TekstC) = xLSheet.Cells(TellerC, TellerE)
                                    RsADO_Project.Update
                                    Next TellerC

                                End If

                            Next TellerE

                        RsADO_CommObsCompare.MoveNext

                        Next TellerD

#5 tromt

tromt

    Professional Developer

  • Leden
  • PipPipPipPip
  • 305 berichten
    Laatst bezocht 03 aug 2020 13:32
  • LocatieRijen (NB)

Geplaatst op 03 februari 2015 - 10:47

Tsja, er zit verschil in onze aanpak.
Ik zou zeggen:
je pakt een gevuld excel-bestand (de controle op veldnamen even buiten beschouwing gelaten)
je kijkt hoeveel regels en hoeveel kolommen en je maakt een geneste lus
bv. For L = 1 to regels (voor de regels) en daarbinnen For K = 1 to kolommen (uiteraard voor de kolommen)
Als je met de For K alle velden hebt gelezen , schrijf je die waarden naar de database met een query: INSERT TO tblXXX(veldnamen comma seperated) VALUES(waarden comma seperated)
en dan de volgende regel.

Ik ga er daarbij van uit dat je ergens (class? module?) code hebt staan om de verbinding met de database te maken, de query uit te voeren en de verbinding weer te sluiten.

Een werkend voorbeeld ,aar dan wel in VB2012express met SQLCE in de bijlage (ik krijg die code om een of andere reden niet netjes er in)...

Bijgevoegde Bestanden







Ook met taq VB6 voorzien

0 gebruiker(s) lezen dit onderwerp

0 lid(leden), 0 bezoeker(s), 0 anonieme gebruikers

Inloggen


[VB6] Untitled 1

Met dank aan J├╝rgen voor de jarenlange inzet van visualbasic.be (anno dec 2000)
Met dank aan Mike en Ronneke voor de jarenlange inzet van vbib.be (anno dec 2010)
Met dank aan PascalBianca voor de jarenlange inzet van vbib.be (anno dec 2016)