Beste experts,
Ik heb een sheet die de geïmporteerde data uit een CSV bestand opslaat als een apart excel bestand. Nadat het bestand succesvol is opgeslagen loop ik vast in de code. Ná opslag staan er dus 2 excel bestanden open. 1. de werkmap, 2. het aangemaakte excel bestand. Omdat het tweede excel bestand nog open staat, kan de code in de 1e werkmap niet worden afgewerkt. Mijn 1e vraag: Hoe kom ik terug in de werkmap zodat de code kan worden afgewerkt? 2e vraag: Kan het 2e opgeslagen bestand met VBA worden gesloten vanuit de code in de werkmap? want nu moet ik het 2e excel bestand handmatig sluiten. Ik heb in de code aangegeven waar het fout gaat. Ik ben maar een leek in VBA, dus als jullie experts de code zien zou je mogelijk kunnen gaan lachen, maar het werkt tot nu toe goed.
Alvast bedankt.
Mvg, Ton
Ik heb een sheet die de geïmporteerde data uit een CSV bestand opslaat als een apart excel bestand. Nadat het bestand succesvol is opgeslagen loop ik vast in de code. Ná opslag staan er dus 2 excel bestanden open. 1. de werkmap, 2. het aangemaakte excel bestand. Omdat het tweede excel bestand nog open staat, kan de code in de 1e werkmap niet worden afgewerkt. Mijn 1e vraag: Hoe kom ik terug in de werkmap zodat de code kan worden afgewerkt? 2e vraag: Kan het 2e opgeslagen bestand met VBA worden gesloten vanuit de code in de werkmap? want nu moet ik het 2e excel bestand handmatig sluiten. Ik heb in de code aangegeven waar het fout gaat. Ik ben maar een leek in VBA, dus als jullie experts de code zien zou je mogelijk kunnen gaan lachen, maar het werkt tot nu toe goed.
Alvast bedankt.
Mvg, Ton
Code:
Private Sub Imprt1eKw_Click()
' eerst checken of het kwartaal in 'Param' goed staat ingesteld
Dim KwCheck As String
Dim KwAbsoluut As String
KwAbsoluut = Sheets("Param").Range("B68").Value
KwCheck = Sheets("Param").Range("F10").Value
If MsgBox("De kwartaal bestandsnaam is nu ingesteld op:" & vbCrLf & KwCheck & vbCrLf & vbCrLf & _
"De kwartaal bestandsnaam zou moeten zijn:" & vbCrLf & KwAbsoluut & vbCrLf & vbCrLf & "Wil je de kwartaal bestandsnaam wijzigen?" & vbCrLf & vbCrLf, _
vbYesNo + vbInformation, "Bestandsnaam - controle") = vbYes Then
Application.Goto Sheets("Param").Range("F10")
Exit Sub
Else
End If
' Eerst kijken of de map bestaat, anders aanmaken. = E:\Werkmap\TDEP_new\Administratie\Kasboeken
sPad = Sheets("Param").Range("F11").Value & "\"
Pad = Split(sPad, "\")
sPad = Pad(0)
For i = 1 To UBound(Pad)
sPad = sPad & "\" & Pad(i)
If Dir(sPad, vbDirectory) = "" Then
MkDir sPad
End If
Next i
' Eerst kijken of in het werkblad data staat.
If WorksheetFunction.CountA(Sheets("Bank_1e_kwart").Columns(1)) = 1 Then
GoTo further
Else
If MsgBox(" BELANGRIJKE INFO " & vbCrLf & vbCrLf & "Achterliggend blad bevat data zoals je kunt zien. Als je nieuwe data wilt importeren, moet eerst de huidige data worden gewist!" & vbCrLf & vbCrLf & _
"Wil je de huidige data wissen en een nieuw CSV bestand te importeren." & vbCrLf & vbCrLf, _
vbYesNo + vbInformation, "CSV comma gescheiden bankbestand importeren") = vbYes Then
Rows("2:5000").ClearContents
Rows("2:2").Select
Dim Kiezen As Integer, Bestand As String
further:
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
Kiezen = .Show
If Kiezen <> 0 Then
Bestand = .SelectedItems(1)
End If
End With
If Bestand = "" Then Exit Sub
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Bestand, Destination:=Range("$A$2"))
.Name = "INGB_1e_kwart_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Exit Sub
Else
End If
End If
'F5 Geef het path op voor opslag van de werkmap kasboek : C:\Werkmap\TDEP\Administratie\Kasboeken
'F6 Geef het path op voor opslag van het sjabloon kasboek : C:\Werkmap\TDEP\Sjabloon kasboek
'F7 Geef de naam op voor dit programma : Kasboek
'F8 Je voornaam : Ton
'F9 Je achternaam : Coolen
'F10 Bestandsnaam : INGB 0007 992960 1e kwart
'F11 Voer het path in waar het excelbestand moet worden opgeslagen : E:\Werkmap\TDEP\Administratie\Bank_import
' Kijken of jaarmap bestaat, anders aanmaken
Dim sYear As String
sYear = CStr(Year(Date))
sPad = Sheets("Param").Range("F11").Value & ("\") & sYear & ("\")
Pad = Split(sPad, "\")
sPad = Pad(0)
For i = 1 To UBound(Pad)
sPad = sPad & "\" & Pad(i)
If Dir(sPad, vbDirectory) = "" Then
MkDir sPad
End If
Next i
If MsgBox("Als er wijzigingen zijn aangebracht in achterliggend blad, klik dan op 'OK' om het bestand op te slaan, en volg dan de aanwijzingen op het scherm. Klik anders op 'Nee' " & vbCrLf & vbCrLf & _
"Wil je dit blad toch opslaan?" & vbCrLf & vbCrLf, _
vbYesNo + vbInformation, "Geïmporteerd bestand opslaan") = vbYes Then
' Het geïmporteerde CSV bestand als apart excelbestand opslaan in de map
Dim ChDir As String
ChDir = Sheets("Param").Range("F11").Value & ("\") & sYear & ("\")
Dim sFileName As String
sFileName = Sheets("Param").Range("F10").Value & (" ") & sYear
Cells.Select
Range("A500").Activate
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs FileName:= _
ChDir & sFileName
' Hierna gaat het fout. Er wordt een kopie van het werkblad 'Bank_1e_kwart'
' en als apart excelbestand opgeslagen, maar dat staat nog open, los van deze werkmap.
' Nadat het bestand is weggeschreven, zou die werkmap moeten worden gesloten en
' worden teruggekeerd naar Application.Goto Sheets("Bank_1e_kwart").Range("A1")
' en de MsgBox moeten laten verschijnen
MsgBox "De CSV data is opgeslagen in:" & vbCrLf & Sheets("Param").Range("F11") & vbCrLf & _
vbCrLf & " " & "onder de naam:" & " " & Sheets("Param").Range("F10").Value, vbOKOnly + vbInformation, "Opslag van geïmporteerd CSV bestand"
End If
End Sub
