Regel kopieren naar een bestand twee posities lager in het pad

Status
Niet open voor verdere reacties.
R

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
901
Beste Helpmij'ers,

Ik heb een vraag waarvan ik mijn twijfels heb of hiervoor een vba-code bestaat.

Mijn bedoeling is om een hele regel vanuit een bronbestand te kopiëren naar een doelbestand dat niet in hetzelfde pad staat, maar twee posities lager.

Als voorbeeld:
Het bron bestand staat in: C:\BAH\Jaarrekening\DJ posten\8 45581 Jansen B.V
en het Doelbestand staat in: C:\BAH\Jaarrekening\

Nu weet ik, dat ik ook het pad zoals hierboven vermeld staat, in de code kan zetten, echter komt het soms voor dat zowel het doel- als het bronbestand in andere posities staan van het pad. Het enige wat altijd gelijk is dat het bronbestand twee posities hoger staat dan het doelbestand.

In mijn huidige code (zie onder) moet ik altijd het doel- als het bronbestand in dezelfde map plaatsen.

Code: 
'Het Werkvoorraad bestand openen, mocht deze al open staan, dan negeren.
Dim WB As Workbook
Application.ScreenUpdating = False
On Error Resume Next
Set WB = Workbooks("Werkvoorraad.xlsm")
On Error GoTo 0
If WB Is Nothing Then
    [COLOR="#FF0000"]Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Werkvoorraad.xlsm")[/COLOR]
Else
    WB.Activate
End If
Set c = Range("a1:a1000").Find(zoekwaarde)
If Not c Is Nothing Then
    c.Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
Else: MsgBox ("V O L G N U M M E R  N I E T  G E V O N D E N , de regel staat in het archief. Om toch te kunnen plakken dien je eerst het volgnummer in het Werkvoorraad bestand te plaatsen!")
End If

Ik hoop dat iemand mij hier mee kan helpen, alvast heel erg bedankt.

Groet, Robert
 
Het pad van het bronbestand kun je met SPLIT uitlezen en in een matrix zetten bijvoorbeeld. Vervolgens kun je met een lus de juiste string samenstellen:
Code: 
For i = LBound(arr) To UBound(arr)-2
     If tmp<>”” Then tmp=tmp & “/“
     Tmp=tmp & arr(i)
Next i
 
Heel erg bedankt voor jouw snelle reactie.

Helaas ben ik te onkundig om precies te begrijpen wat jij bedoelt. Zou je het misschien in mijn code kunnen plaatsen, tenminste als dat de bedoeling is.
 
Is het zo duidelijker

Code: 
Sub VenA()
  c00 = "C:\BAH\Jaarrekening\DJ posten\8 45581 Jansen B.V"
  ar = Split(c00, "\")
  For j = 0 To UBound(ar) - 2
    c01 = c01 & ar(j) & "\"
  Next j
  MsgBox c01
End Sub
 
Bedankt ook voor jouw reactie.

Het is de bedoeling dat de code in ieder willekeurig pad werkt en altijd twee posities terug gaat om het doelbestand te vinden. Ik begrijp uit jouw code dat ik altijd vanuit hetzelfde pad de code moet activeren.
 
Gebruik dan in het voorbeeld van VenA niet het vaste pad maar dit:
Code: 
c00 = Thisworkbook.Path
 
Volgens mij doe ik iets niet goed, ik zal mijn volledige code geven.
Code: 
Sub Rapportage()
If vbNo = MsgBox("Heb je het Wordsjabloon afgesloten? Zo niet doe dat dan eerst. " & vbCrLf & vbCrLf & _
"Ben je zeker dat je de gegevens wilt verzenden? ", vbYesNo) Then Exit Sub

  c00 = ThisWorkbook.Path
  ar = Split(c00, "\")
  For j = 0 To UBound(ar) - 2
    c01 = c01 & ar(j) & "\"
  Next j
  MsgBox c01

ActiveSheet.Unprotect
Range("a2:GW2").Select
Selection.Copy
Dim zoekwaarde
Dim c
zoekwaarde = [a2].Value

'Het Werkvoorraad bestand openen, mocht deze al open staan, dan negeren.
Dim WB As Workbook
Application.ScreenUpdating = False
On Error Resume Next
Set WB = Workbooks("Werkvoorraad.xlsm")
On Error GoTo 0
If WB Is Nothing Then
    Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Werkvoorraad.xlsm")
Else
    WB.Activate
End If
Set c = Range("a1:a1000").Find(zoekwaarde)
If Not c Is Nothing Then
    c.Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
Else: MsgBox ("V O L G N U M M E R  N I E T  G E V O N D E N , de regel staat in het archief. Om toch te kunnen plakken dien je eerst het volgnummer in het Werkvoorraad bestand te plaatsen!")
End If

 
'het Werkvoorraad bestand opslaan
ActiveWorkbook.Save
'ActiveWorkbook.Close True
End Sub
 
Wat er niet goed gaat vertel je er niet bij.
Maar je gebruikt ook het door de code van VenA genenereerde pad in c01 nergens.
 
Sorry, de fout zit in regel
Code: 
  Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Werkvoorraad.xlsm")

Het systeem vindt hier het bestand "Werkvoorraad.xlsm" niet. Dit lijkt mij ook logisch omdat het bestand ook niet in dat pad staat.
 
Ik heb het gevonden, voornoemde regel moet worden.
Code: 
    Set WB = Workbooks.Open(Filename:=c01 & "\Werkvoorraad.xlsm")

Volgens mij werkt het nu helemaal goed, ik ga nog even wat experimenteren.

Iedereen alvast heel erg bedankt voor jullie hulp. :thumb:
 
Dat bedoelde ik ;)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan