Solved Need to rename a file after copy to another folder (1 Viewer)

5hadow

Member
Local time
Today, 05:00
Joined
Apr 26, 2021
Messages
89
Hello all

So far I have this code:

Code:
Private Sub btnGenerate_Click()
    Const strParent = "M:\429 QMO\Document Reviews\Document Reviews\"
    Dim strSerial As String
    Dim strSFolder As String
    Dim strFolder As String
    Dim fso As Object
    Dim FDate As String
    Dim Path As String
    Dim TRevChk As String
    TRevChk = Forms!frmConfig!fileTRevChk.Value
    Dim TPriAss As String
    TPriAss = Forms!frmConfig!fileTPriAss.Value
    Path = strParent & Me.fldSerial
    FDate = Format(Now, "yyyy")
    strSFolder = strParent & FDate & "\"
    strFolder = strParent & FDate
    strSerial = Me.fldSerial
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    
    On Error Resume Next
    If FolderExists(strFolder) = False Then
        fso.CreateFolder strFolder
    End If
    If fso.FolderExists(strSFolder & strSerial) = False Then
        fso.CreateFolder strSFolder & strSerial
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\", no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\", no)
    Else
        MsgBox "Folder " & strSerial & " already exists"
        MsgBox "Path " & TRevChk & " exists"
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\", no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\", no)
    End If
    Me.txtFileDoc.Value = Path
    
       Shell "explorer.exe " & strSFolder & Me.fldSerial, vbNormalFocus
    Me.Requery
End Sub

It creates a main folder with year (ie: 2021) if it doesn't exist
Then, It creates a subfolder based on a field (ie: DR-21-007) if it doesn't exist
Then, It copies two files with paths input from another two fields. (Storage for path, user defined) to above folder

Now, I also want to rename the file to what it was + & strSerial

I was thinking, in the following line: Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\", no)
Change to: Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" name Path & filename AS path & newname, no)

Is my thinking wrong for above?
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:00
Joined
Oct 29, 2018
Messages
21,357
Now, I also want to rename the file to what it was + & strSerial
Hi. Can you show us an example of what a value in TRevChk would look like?
 

5hadow

Member
Local time
Today, 05:00
Joined
Apr 26, 2021
Messages
89
Hi. Can you show us an example of what a value in TRevChk would look like?
Hi,

Yes, the value would look like:

M:\429 QMO\Document Reviews\Doc Review Package\DND 4719-E WI Review Checklist.pdf
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:00
Joined
Oct 29, 2018
Messages
21,357
Hi. Thanks. You could try using this function to get the filename and then use it in your FileCopy.

Code:
Public Function GetFilename(FilePath As String) As String
'thedbguy@gmail.com
'10/1/2021

GetFilename = Mid(FilePath, InStrRev(FilePath, "\") + 1)

End Function
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:00
Joined
May 7, 2009
Messages
19,169
you need to change this portion:

Code:
..
    If fso.FolderExists(strSFolder & strSerial) = False Then
        fso.CreateFolder strSFolder & strSerial
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    Else
        MsgBox "Folder " & strSerial & " already exists"
        MsgBox "Path " & TRevChk & " exists"
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    End If
..
 

5hadow

Member
Local time
Today, 05:00
Joined
Apr 26, 2021
Messages
89
you need to change this portion:

Code:
..
    If fso.FolderExists(strSFolder & strSerial) = False Then
        fso.CreateFolder strSFolder & strSerial
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    Else
        MsgBox "Folder " & strSerial & " already exists"
        MsgBox "Path " & TRevChk & " exists"
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    End If
..
Works great, thanks!

One more question,
To add to above code, I also want to add another file from sharepoint to that same folder. My tables are imported from sharepoint so I already have URL stored in tables!WordDocs!Name as hyperlink and there are also "Path", "URL Path" and "Encoded absolute URL" all auto generated by importing sharepoint table. I assume I can use one of these to input in my code to download a file, put it into generated folder in code above.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:00
Joined
Oct 29, 2018
Messages
21,357
Works great, thanks!

One more question,
To add to above code, I also want to add another file from sharepoint to that same folder. My tables are imported from sharepoint so I already have URL stored in tables!WordDocs!Name as hyperlink and there are also "Path", "URL Path" and "Encoded absolute URL" all auto generated by importing sharepoint table. I assume I can use one of these to input in my code to download a file, put it into generated folder in code above.
To download a file from the Internet, you could give this one a try.

 

5hadow

Member
Local time
Today, 05:00
Joined
Apr 26, 2021
Messages
89
To download a file from the Internet, you could give this one a try.

I tried:
Code:
Dim objHTTP As Object
Dim FileByte() As Byte
Dim strFile As String
Dim intFile As Integer
Dim URL As String

URL = Forms!frmWIDetails!txtDoc.Value
intFile = Forms!frmWIDetails!txtDoc.Value()
strFile = Mid(URL, InStrRev(URL, "/") + 1)

Set objHTTP = CreateObject("Microsoft.XMLHTTP")

With objHTTP
    .Open "GET", URL, False
    .Send
    If .Status = 200 Then
        FileByte = .responseBody
    End If
End With

Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile
    Put #intFile, , FileByte
Close #intFile

Set objHTTP = Nothing

Doesn't do anything
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:00
Joined
Oct 29, 2018
Messages
21,357
I tried:
Code:
Dim objHTTP As Object
Dim FileByte() As Byte
Dim strFile As String
Dim intFile As Integer
Dim URL As String

URL = Forms!frmWIDetails!txtDoc.Value
intFile = Forms!frmWIDetails!txtDoc.Value()
strFile = Mid(URL, InStrRev(URL, "/") + 1)

Set objHTTP = CreateObject("Microsoft.XMLHTTP")

With objHTTP
    .Open "GET", URL, False
    .Send
    If .Status = 200 Then
        FileByte = .responseBody
    End If
End With

Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile
    Put #intFile, , FileByte
Close #intFile

Set objHTTP = Nothing

Doesn't do anything
Hi. I responded to your other thread on this topic.
 

Users who are viewing this thread

Top Bottom