Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    Apr 2014
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts

    folder creation and moving pictures into that newly created folder at different location

    Hello friends, I have two queries,
    Issues:
    1. issue explanation- Pls check the attachment file "folder creation and fotos copied into the newly created folder at the specified folder,.. "
    2. issue explanation: Pls refer the spreadsheet file "search & open that created folder from spreadsheet cell value linked thru hyperlink"

    Issue Summary: when click it need to make a new folder on different location (d:\db) and then copying of photos into that created folder from photos source location (c:\fotos folder) to the destination of newly created folder (d:\db) from the cell value (eg: C4 as 9224) of spreadsheet. and also, i'm looking for the coding of cell value linked to that newly created folder as a hyperlink to open whenever we want to check the folder files...

    Pls check the attachment files for issue clarity... Thanks in advance for your time and effort for reading...

    I think this is the extreme usage of excel, but I hope from our excel gurus to solve this type of scenario…

    Any help will be highly appreciated in this regard….

    Code:
    I tried some coding here, but it is not working... pls look into  the codes as below: 
    
    Folder creation with cell value: this is a working code, pls check this code, if need modification, pls do it. Thanks
    Code:
    Sub MakeFolders()
     
    Dim FldrName As String
     
    On Error Resume Next
     
    For i = 1 To 10
       FldrName = ActiveCell.Value
       MkDir "C:\Make folder-test\" & FldrName
    Next i
     MsgBox "folder created, Done!!!!"
    End Sub
     
     
     Copying the images from the source to destination code: It is not working, pls look into the code, where it is wrong.. tried from file copy command to copy from source to destination, but unable …
    Sub CopyFileAddDate()
       
        Dim SrceFile1, SrceFile2
      Dim copyingfname As String
     
    On Error Resume Next
     
    For i = 1 To 10
        SrceFile1 = "C:\Users\new browsing\Desktop\My phot\Images\copyingfname" & ".jpg"
       
        DestFile1 = "C:\Make folder-test\copyingfname" & Format(Now, "yyyy-mm-dd hh-mm-ss") & ".jpg"
        FileCopy SrceFile1, DestFile1
       
        Next i
    End Sub
     
    Hyperlink code: 
     
    Public Sub openHyperlink_ActiveCellValue_LOOP()
    Dim fldr As Folder
    Dim AA As Object, fpath1 As String
    fpath1 = "C:\Make folder-test\AA"
    AA = ActiveCell & fldr
        On Error GoTo 1
        ActiveWorkbook.FollowHyperlink ActiveWorkbook.Path & _
        "\fpath1", NewWindow:=True
        Exit Sub
    1:           MsgBox Err.Description
    End Sub
     
      OR 
    The first part in this code is to invoke the system32 files to open folder: from the location: %SystemRoot%\system32\SHELL32.dll
     
     
    Private Declare Function SetCurrentDirectoryA Lib _
                                                  "kernel32" (ByVal lpPathName As String) As Long
    Sub ChDirNet(szPath As String)
        Dim lReturn As Long
        lReturn = SetCurrentDirectoryA(szPath)
        If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
    End Sub
     
    Public Sub CreateHyperlink_ActiveCellValue_LOOP()
    On Error GoTo Whoops
    OriginalCalculationMode = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Dim foldername As String
     
    foldername = ActiveCell.Value
    Set Getfolder = CreateObject("Scripting.FileSystemObject.GetFolder")
    OpenFolder = ("C:\Users\new browsing\Documents\foldername")
    Application.ScreenUpdating = False
    Sheets("EPR Tracker").Activate
    Do While Not IsEmpty(ActiveCell)
    If Err.Number <> 0 Then
    Err.Clear
    ActiveSheet.Hyperlinks.Add _
    Anchor:=Selection, _
    Address:=ActiveCell.Value, SubAddress:=OpenFolder, _
    TextToDisplay:=ActiveCell.Value
    End If
    foldername = ActiveCell.Value & Folder.Open
       If IsError(Dir(OpenFolder & foldername)) = 1004 Then
    Err.Clear
     End If
    If FileSystemObject.FolderExists = True Then
    Folder.Name Open:=OpenFolder & foldername
    End If
    Loop
    ActiveCell.Offset(1, 0).Select
    ActiveWorkbook.Save
    Exit Sub
    Whoops:
    Application.Calculation = OriginalCalculationMode
    Application.ScreenUpdating = True
    End Sub
     ----------------------

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 651 Times in 593 Posts
    Meer,
    There were too many problems with your posted code so better to start from scratch. The following code should do what you want to do.

    It will take the value of the active cell to create and name a new sub folder under C:\db\. It will then copy all .jpg files from your source folders C:\fotos folder\ to the new folder and rename them by inserting the date and time to the name. Lastly, it will make the cell value a hyperlink to open the new folder created.

    HTH,
    Maud

    Code:
    Sub MakeFolders()
    On Error Resume Next
    '--------------------------------------------
    'DIM VARIABLES
    Dim FldrName As String
    Dim SourcePath As String
    Dim DestinationPath As String
    '--------------------------------------------
    'SET SOURCE AND DESTINATION PATHS
    SourcePath = "C:\fotos folder\"
    FldrName = ActiveCell.Value
    MkDir "D:\db\" & FldrName & "\"
    DestinationPath = "D:\db\" & FldrName & "\"
    '--------------------------------------------
    'COPY FILES FROM SOURCE TO DESTINATION
    Filename = Dir(SourcePath & "*.jpg")
    Do While Len(Filename) > 0
        FileCopy SourcePath & Filename, DestinationPath & Format(Now, "yyyy-mm-dd hh-mm-ss") & "_" & Filename
        Filename = Dir
    Loop
    '--------------------------------------------
    'ADD HYPERLINK
    ActiveSheet.Hyperlinks.Add ActiveCell, DestinationPath
    End Sub

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    meer_ali (2014-04-22)

  4. #3
    New Lounger
    Join Date
    Apr 2014
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Dear sir,

    Muaaaa!!!!!You are excellent, you are amazing, you are mind blowing....

    I admit I make mistakes because there are guides like you to correct me....

    God bless you with lots of happiness and health!!!! I have no words to thank you!!!!

    Sir, you done it so neatly, effeciently, and precise that I can tell you are an expert in this excel programming...

    I needed completely to move the pictures from the folder or delete the pictures from that picture folder after being copied into destination... because there would be another set of pictures to be loaded from scanner into that same folder directory for another PR no.s..... and then another PR.no.s... so on...

    could you tell me one line code to delete that pictures after pictures being copied..

    Thanks once again....

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •