Page 2 of 30 FirstFirst 123412 ... LastLast
Results 11 to 20 of 294

Thread: Appendix Thread. ( Codes for other Threads, ( Avinash ).)

  1. #11
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10

    Share account for testing file access from a hyperlink in a received EMail

    Share account for testing file access from a hyperlink in a received EMail
    In support of a possible solution to this post in this Thread:
    http://www.excelfox.com/forum/showth...0724#post10724

    It is required to have a simple hyperlink to an Excel File appear in the received Email sent to members of a team.
    I am not sure currently how to get a link directly to the File.

    An second alternative involves storing the file at a File sharing site and using the link to the file as the URL part of a hyperlink.

    This post discusses the setting up of such an account to allow storing of, and sharing via a supplied link to, the file.

    As an example of a file sharing site we consider the free version of box.net
    Some googling my be needed to finally get at the free version which may go under the name of “free” , “Individual rate”, “Personal free”
    Currently you need to find your way to the free 10GB offer. This is currently at this link:
    https://account.box.com/signup/n/personal#fbms6
    Free10GB box net account register.JPG : https://imgur.com/NB3GThi
    Note , by registering, you can choose a language to suit you.
    Free10GB Select language .JPG : : https://imgur.com/aNzW1kq
    ( You can change the language to a different one after registering also
    Free10GB Change language .JPG : https://imgur.com/IosqbAI )


    For this registering , I use the created gmail account used for experiments in the current thread which this post supports, excellearning12@gmail.com ( excelfox Thread : http://www.excelfox.com/forum/showth...and-send-email )

    The password I pass on privately to those needing
    Free10GB box net account register 2.JPG : https://imgur.com/Y2pLogO
    Free10GB box net account register 3.JPG : https://imgur.com/QhCR8fP
    Free10GB box net account register Verify Email 4.JPG : https://imgur.com/ffG7erw

    Various steps are then gone through, they may be slightly different to the following:

    At some point you should you should see the possibility to upload a file, following steps similar to these:
    Free10GB box net 5 .JPG : https://imgur.com/lNWvQwF
    To upload a file and get a URL link to use in a hyperlink to it:
    Upload Files:
    Free10GB box net 6 .JPG : https://imgur.com/rTU1Xbk
    Select a file:
    Free10GB box net 7 .JPG : https://imgur.com/wKKlqoO
    Select share to obtain a URL link to the file :
    Free10GB box net 8 .JPG : https://imgur.com/R3VbyhR
    Copy link to be used in Hyperlink :
    Free10GB box net 9 .JPG : https://imgur.com/8yaYwaK
    A Folk, A Forum, A Fuhrer ….

  2. #12
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10

    Testing Hyperlinks in received EMail

    Testing codes in support of this Thread
    http://www.excelfox.com/forum/showth...0727#post10727







    Codes for Alf and sandy666
    Code:
    Option Explicit
    Sub SendfromExcelVBAExpgmail()
    Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519
    'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
        '6a(i)
        With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
        Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
         .Configuration(LCD_CW & "smtpusessl") = True '
         .Configuration(LCD_CW & "smtpauthenticate") = 1  '
        '  ' Sever info
         .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
        '  The mechanism to use to send messages.
         .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
         .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25  ' 465 or 25 for t-online.de 'or 587 'or 25
        '
         .Configuration(LCD_CW & "sendusername") = "ExcelVBAExp@gmail.com" '
         .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxxx"       '                                  '
    '     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
    '     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
        ' Optional - How long to try
         .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
        ' Intraction protocol is Set/ Updated
         .Configuration.Fields.Update '
        'End With 6a(i)' ----------------------        my Created  LCDCW Library
        '6a(ii) With   ' -- ' Data to be sent---       my Created  LCDCW Library
         Dim strHTML As String: Let strHTML = "<font size=""3"" face=""Calibri"">" & _
         "This is sent from EMail account:" & _
         "<br>Username: ""ExcelVBAExp@gmail.com""" & _
         "<br>Password: ""xxxxxxxxxxxxxxxxxxxxxx""" & _
         "<br><br>" & _
         "<br>Please click on the 5 links below and tell me what happens, thanks!" & _
         "<br>1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _
         "<br>2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _
         "<br>5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>"
        .To "xxxxxxxxxxxxxx"
        .CC "xxxxxxxxxxxxxa"
    
        .BCC = ""
        .from = """ExcelVBAExp@gmail.com"" <ExcelVBAExp@gmail.com>"
        .Subject = "Sent from EMail address: ExcelVBAExp@gmail.com"
        .htmlbody = strHTML
    
        .Send ' Do it
        End With ' 6a(ii) CreateObject("CDO.Message") ---my Created  LCDCW Library
    End Sub
    
    Sub SendfromFahrradprinzessinunterwegsgmail()
    Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519
    'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
        '6a(i)
        With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
        Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
         .Configuration(LCD_CW & "smtpusessl") = True '
         .Configuration(LCD_CW & "smtpauthenticate") = 1  '
        '  ' Sever info
         .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
        '  The mechanism to use to send messages.
         .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
         .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25  ' 465 or 25 for t-online.de 'or 587 'or 25
        '
         .Configuration(LCD_CW & "sendusername") = "Fahrradprinzessinunterwegs@gmail.com" '
         .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxx"       '                                  '
    '     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
    '     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
        ' Optional - How long to try
         .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
        ' Intraction protocol is Set/ Updated
         .Configuration.Fields.Update '
        'End With 6a(i)' ----------------------        my Created  LCDCW Library
        '6a(ii) With   ' -- ' Data to be sent---       my Created  LCDCW Library
         Dim strHTML As String: Let strHTML = "<font size=""3"" face=""Calibri"">" & _
         "This is sent from EMail account:" & _
         "<br>Username: ""Fahrradprinzessinunterwegs@gmail.com""" & _
         "<br>Password: ""xxxxxxxxxxxxxxxxxxx""" & _
         "<br><br>" & _
         "<br>Please click on the 5 links below and tell me what happens, thanks!" & _
         "<br>1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _
         "<br>2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _
         "<br>5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>"
        .To "xxxxxxxxxxxxxxxxxxxx"
        .CC "xxxxxxxxxxxxxxxxxxx"
        .BCC = ""
        .from = """Fahrradprinzessinunterwegs@gmail.com"" <Fahrradprinzessinunterwegs@gmail.com>"
        .Subject = "Sent from EMail address: Fahrradprinzessinunterwegs@gmail.com"
        .htmlbody = strHTML
    
        .Send ' Do it
        End With ' 6a(ii) CreateObject("CDO.Message") ---my Created  LCDCW Library
    End Sub
    
    
    
    Sub SendfromDocAlnsteinGermanTelekom()
    Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519
    'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
        '6a(i)
        With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
        Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
         .Configuration(LCD_CW & "smtpusessl") = True '
         .Configuration(LCD_CW & "smtpauthenticate") = 1  '
        '  ' Sever info
         .Configuration(LCD_CW & "smtpserver") = "securesmtp.t-online.de" ' "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
        '  The mechanism to use to send messages.
         .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
         .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25  ' 465 or 25 for t-online.de 'or 587 'or 25
        '
         .Configuration(LCD_CW & "sendusername") = "Doc.Alnstein@t-online.de" '
         .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxx"       '                                  '
    '     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
    '     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
        ' Optional - How long to try
         .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
        ' Intraction protocol is Set/ Updated
         .Configuration.Fields.Update '
        'End With 6a(i)' ----------------------        my Created  LCDCW Library
        '6a(ii) With   ' -- ' Data to be sent---       my Created  LCDCW Library
         Dim strHTML As String: Let strHTML = "<font size=""3"" face=""Calibri"">" & _
         "This is sent from EMail account:" & _
         "<br>Username: ""Doc.Alnstein@t-online.de""" & _
         "<br>Password: ""xxxxxxxxxxx""" & _
         "<br><br>" & _
         "<br>Please click on the 5 links below and tell me what happens, thanks!" & _
         "<br>1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _
         "<br>2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _
         "<br>5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>"
        .To "xxxxxxxxxxxxxxxxxxxxxxxx"
        .CC "xxxxxxxxxxxxxxxxxxxxxxxxx"
    
        .BCC = ""
        .from = """Doc.Alnstein@t-online.de"" <Doc.Alnstein@t-online.de>"
        .Subject = "Sent from EMail address: Doc.Alnstein@t-online.de"
        .htmlbody = strHTML
    
        .Send ' Do it
        End With ' 6a(ii) CreateObject("CDO.Message") ---my Created  LCDCW Library
    End Sub
    Instructions:
    Three files are attached. Please download them and store them all somewhere on your computer. They can be stored anywhere, but important is that they are all stored in the same Folder :
    All 3 files stored in same place.JPG : https://imgur.com/rFu0TML

    Please open only one file “Test File xxxx to send EMail containing Hyperlinks to Files.xlsm
    Enable macros.

    There are three codes in file “Test File xxxx to send EMail containing Hyperlinks to Files.xlsm”.
    The codes are very similar, differing only in the Email account used as the .Sender:
    Sub SendfromDocAlnsteinGermanTelekom()
    Sub SendfromFahrradprinzessinunterwegsgmail()
    Sub SendfromExcelVBAExpgmail()


    Please try to run those codes.
    Each code should send you an Email which on arrival will look something similar to this:
    Typical received EMail.JPG : https://imgur.com/4oNXNtW

    Please click on the 5 Hyperlinks and tell me what happens.


    My final goal is to get a Hyperlink which when clicked opens an Excel or Word File.
    I have tested the codes sending to my gmail and German Telekom Email accounts.
    But so far, only link 1 works. But link 1 does not open a file: It simply sends you to a file sharing site. So link 1 is a temporary solution for me.









    Code for Thai in next post....
    A Folk, A Forum, A Fuhrer ….

  3. #13
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10
    Code for Thai .
    Code:
    Option Explicit
    Sub Sendfromexcellearninggmail()
    Rem 6 EMail send 'For info see:  http://www.excelfox.com/forum/showthread.php/2233-Urgent-support-needed-Multiple-emails-multiple-Excel-workbooks-at-once#post10519
    'Working at my end With my With End With Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups)
        '6a(i)
        With CreateObject("CDO.Message") ' -Linking Cods Wollups--------
        Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/"
         .Configuration(LCD_CW & "smtpusessl") = True '
         .Configuration(LCD_CW & "smtpauthenticate") = 1  '
        '  ' Sever info
         .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "smtp.office365.com" ' "smtp.live.com" ' "smtp-mail.outlook.com" ' "smtp.live.com" ' "smtp.gmail.com" ' "securesmtp.t-online.de" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"
        '  The mechanism to use to send messages.
         .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
         .Configuration(LCD_CW & "smtpserverport") = 465 ' 465 or 25 for gmail '587 ' 25  ' 465 or 25 for t-online.de 'or 587 'or 25
        '
         .Configuration(LCD_CW & "sendusername") = "excellearning12@gmail.com" '
         .Configuration(LCD_CW & "sendpassword") = "xxxxxxxxxxxxx"       '                                  '
    '     .Configuration(LCD_CW & "sendusername") = "YourEMailAddress"
    '     .Configuration(LCD_CW & "sendpassword") = "YourEMailPassword"
        ' Optional - How long to try
         .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '
        ' Intraction protocol is Set/ Updated
         .Configuration.Fields.Update '
        'End With 6a(i)' ----------------------        my Created  LCDCW Library
        '6a(ii) With   ' -- ' Data to be sent---       my Created  LCDCW Library
         Dim strHTML As String: Let strHTML = "<font size=""3"" face=""Calibri"">" & _
         "This is sent from EMail account:" & _
         "<br>Username: ""excellearning12@gmail.com""" & _
         "<br>Password: ""xxxxxxxxxxxxx""" & _
         "<br><br>" & _
         "<br>Please click on the 5 links below and tell me what happens, thanks!" & _
         "<br>1 <A HREF=""https://app.box.com/s/x01liz3ralbdrt152i52fpwb0wx40ff3"">link to box net cloud free file sharing</A>" & _
         "<br>2 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>3 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received EMail.htm"""">htm file on your computer</A>" & _
         "<br>4 <A HREF=""file://" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>" & _
         "<br>5 <A HREF=""file:///" & ThisWorkbook.Path & "\" & "Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls"""">empty xls file on your computer</A>"
        .To = "THai xxxxxxxxx"
        '.CC = "xxxxxxxxxxxxx"
        .BCC = ""
        .from = """excellearning12@gmail.com"" <excellearning12@gmail.com>"
        .Subject = "Sent from EMail address: excellearning12@gmail.com"
        .htmlbody = strHTML
    
        .Send ' Do it
        End With ' 6a(ii) CreateObject("CDO.Message") ---my Created  LCDCW Library
    End Sub
    Testing files( sent privately ) :
    I have also posted 3 files to you using our share g mail account , ExcelVBAExp@gmail.com
    Please can you also try out the test…

    Please do the following.

    _1) Download all three files , and important: All must be stored in the same Folder.
    ( the three files are:
    Test file DOThtm to be stored on your computer to try to open with a Hyperlink in a received Email.htm
    Empty test file DOTxls stored on your computer to try to open from Hyperlink in arrived Email.xls
    Test File Thai to send EMail containing Hyperlinks to Files.xlsm
    )

    _2) Open only file Test File Thai to send EMail containing Hyperlinks to Files.xlsm
    Run code Sub Sendfromexcellearninggmail()

    You should receive an Email similar to these:
    Alan 5 Links in German Telekom.JPG : https://imgur.com/LeASbhf
    Attachment 2079
    Alan 5 Links in gmail.JPG : https://imgur.com/0sdyZEj
    Attachment 2080

    _3) Please click on the links.

    _4) Please reply and tell me what happens when you click each link

    Thanks
    Alan
    Attached Images Attached Images
    A Folk, A Forum, A Fuhrer ….

  4. #14
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10
    test results from code above, ( http://www.excelfox.com/forum/showth...0762#post10762 ) in support of this post:
    http://www.excelfox.com/forum/showth...0764#post10764

    Using Excel 2007 32 bit
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    M
    1
    Original Original Original Original Original Original Test Output NEW NEW NEW NEW NEW NEW
    2
    Assembly #: Assembly Name: Assembly #: Assembly Name:
    3
    Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN
    4
    1
    Nu Torque
    13456
    456
    456
    1
    Nu Torque
    13456
    456
    456
    5
    1
    Blu Origin Spaceship
    457
    457
    1
    Blu Origin Spaceship
    457
    457
    6
    2
    Jet Blue21 ABC
    458
    458
    2 Jet Blue21 ABC 458 458 < > 2 Jet Blue23 ABC DEF DEF
    2
    Jet Blue23 ABC DEF DEF
    7
    3
    EXCELL123
    123
    ABC ABC
    3
    EXCELL123
    123
    ABC ABC
    8
    3
    Toyota Supra
    460
    460
    3
    Toyota Supra
    460
    460
    9
    2
    Emirate ABC12345
    461
    461
    2
    Emirate ABC12345
    461
    461
    10
    1
    Angel ABC12346
    462
    462
    MISSING: 1 Angel ABC12346 462 462
    2
    Jet Blue21 ABC
    458
    458
    Worksheet: Result

    Using Excel 2007 32 bit
    Original Original Original Original Original Original Test Output NEW NEW NEW NEW NEW NEW
    Assembly #: Assembly Name: Assembly #: Assembly Name:
    Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN
    1
    Nu Torque
    13456
    456
    456
    1
    Nu Torque
    13456
    456
    456
    1
    Blu Origin Spaceship
    457
    457
    1
    Blu Origin Spaceship
    457
    457
    2
    Jet Blue21 ABC
    458
    458
    2 Jet Blue21 ABC 458 458 < > 2 Jet Blue23 ABC DEF DEF
    2
    Jet Blue23 ABC DEF DEF
    3
    EXCELL123
    123
    ABC ABC
    3
    EXCELL123
    123
    ABC ABC
    3
    Toyota Supra
    460
    460
    3
    Toyota Supra
    460
    460
    2
    Emirate ABC12345
    461
    461
    2
    Emirate ABC12345
    461
    461
    1
    Angel ABC12346
    462
    462
    MISSING: 1 Angel ABC12346 462 462
    2
    Jet Blue21 ABC
    458
    458
    Worksheet: Result


    Using Excel 2007 32 bit
    Row\Col
    G
    1
    Test Output
    2
    3
    4
    5
    6
    2 Jet Blue21 ABC 458 458 < > 2 Jet Blue23 ABC DEF DEF
    7
    8
    9
    10
    MISSING: 1 Angel ABC12346 462 462
    Worksheet: Result
    A Folk, A Forum, A Fuhrer ….

  5. #15
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10
    Test data in support of this Post:
    http://www.excelfox.com/forum/showth...0766#post10766



    Using Excel 2007 32 bit
    Row\Col
    A
    B
    C
    D
    E
    F
    1
    1 L 1 1 L 1,1 L 1
    2
    1 G 1 1 E 1 1 L 1,1 L 1 1 E 1
    3
    1 G 1 1 E 1 1 L 1,1 L 1 1 E 1 1 G 1
    4
    1 E 1 1 G 1
    5
    Worksheet: Sheet2


    Using Excel 2007 32 bit
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    1
    1 L 1 1 E 1 1 L 1,1 L 1 1 G 1
    2
    1 G 1 1 E 1 1 L 1 1 L 1 1 G 1
    3
    1 L 1 1 L 1,1 L 1 1 L 1 1 G 1
    4
    1 L 1 1 L 1,1 L 1
    5
    1 L 1 1 G 1 1 E 1 1 L 1
    6
    1 G 1 1 L 1 1 L 1,1 L 1 1 L 1 1 L 1 1 G 1
    7
    1 E 1 1 E 1 1 L 1,1 L 1 1 L 1 1 G 1
    8
    1 E 1 1 G 1 1 E 1 1 L 1,1 L 1 1 G 1 1 G 1 1 G 1 1 G 1
    9
    1 E 1 1 E 1 1 L 1 1 L 1 1 G 1 1 G 1 1 G 1 1 G 1 1 G 1
    10
    Worksheet: Sheet3


    _._______________________

    The results after running the code given on Post #3 of main Thread ( http://www.excelfox.com/forum/showth...0766#post10766 )
    Using Excel 2007 32 bit
    Row\Col
    A
    B
    C
    D
    1
    20abc
    2
    abc20
    3
    def
    4
    ghi
    5
    Worksheet: Sheet4
    A Folk, A Forum, A Fuhrer ….

  6. #16
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10

    Attaching a File to a Thread post at excelfox

    Attaching a File to a Thread post at excelfox
    1 To get Manage Attachments Window dialogue box
    First you must get up the Manage Attachments Window dialogue box.

    _(i) For a new Thread
    Either
    _1_(i) _a) Select Paper clip icon
    Or
    _1_(i) _b) Scroll down and select manage attachments
    a)PaperClipIcon or b)ManageAttachmants.JPG : https://imgur.com/YFEUDUh

    (ii) For a Reply or when Editing an existing post
    _ Hit Reply button or Edit Post Button
    Reply or Edit Post.JPG : https://imgur.com/Bm1Zy6T
    _ Hit Go Advanced button
    GoAdvancedReplyWindow.JPG , GoAdvanced1.JPG : https://imgur.com/QLhHBGl , https://imgur.com/WXoKcoF
    _ Scroll down and select manage attachments
    Scroll down to Hit manage Attachments.JPG : https://imgur.com/uNkr6Eq



    Finally you should see the Manage Attachments Window dialogue box
    Manage Attachments Window dialogue box.JPG : https://imgur.com/BFFUIuG
    Attachment 2103

    Using this dialogue box window you can manage your attachments
    2 To add a File to the current post:
    Steps like the following are needed to attach a file to the current post. It may look a little bit different on your computer
    _ Add Files.JPG : https://imgur.com/hIdo0Av
    _ SelectFiles.JPG : https://imgur.com/9XZJuig
    _ UploadFiles5.JPG : https://imgur.com/f0PXtVA
    _ Done6.JPG : https://imgur.com/a6oFeIQ
    That's it!...
    The file should now have been attached.


    _._______

    Practice before posting in a main Thread:
    You can practice uploading a file by starting a new test thread here:
    http://www.excelfox.com/forum/forumd...p/17-Test-Area
    Give the Thread a title such as …"Just testing. No Reply needed"
    Test Area new Thread 1 .JPG , Test Area new Thread just testing .JPG https://imgur.com/S3uneWf , https://imgur.com/gUFHcBp

    You can then practice uploading attachments or you can also practice any other posting and editing features, such as code tags ( http://www.excelfox.com/forum/showth...0690#post10690 )

    _._____________________________



    Alternative to attaching a file: post a link to your file held at a file share site:
    See here for example:
    http://www.excelfox.com/forum/showth...age8#post10725
    Or if you are familiar with file sharing sites go direct here
    https://account.box.com/signup/n/personal#58luf
    Attached Images Attached Images
    A Folk, A Forum, A Fuhrer ….

  7. #17
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10
    In support of this Post
    http://www.excelfox.com/forum/showth...0771#post10771

    Using Excel 2007 32 bit
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    M
    N
    O
    P
    Q
    1
    Original Original Original Original Original Original Test Output Test Output Test Output Test Output Test Output NEW NEW NEW NEW NEW NEW
    2
    Assembly #: Assembly Name: Assembly #: Assembly Name:
    3
    Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN Qty Per Ref/Designator Description Customer PN Internal PN Manufacture PN
    4
    1
    Nu Torque ABC
    456
    456
    ABC < > 13456
    1
    Nu Torque
    13456
    456
    456
    5
    1
    Blu Origin Spaceship
    457
    457
    1
    Blu Origin Spaceship
    457
    457
    6
    2
    Jet Blue21 ABC
    458
    458
    2
    New: Jet Blue23 ABC New: DEF New: DEF
    2
    Jet Blue23 ABC DEF DEF
    7
    3
    EXCELL123
    123
    ABC ABC
    3
    EXCELL123
    123
    ABC ABC
    8
    3
    Toyota Supra
    460
    460
    3
    Toyota Supra
    460
    460
    9
    2
    Emirate ABC12345
    461
    461
    2
    Emirate ABC12345
    461
    461
    10
    1
    Angel ABC12346
    462
    462
    MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462
    2
    Jet Blue21 ABC
    458
    458
    Worksheet: Result Wanted




    Using Excel 2007 32 bit
    1
    Nu Torque ABC
    456
    456
    ABC < > 13456
    1
    Nu Torque
    13456
    456
    456
    1
    Blu Origin Spaceship
    457
    457
    1
    Blu Origin Spaceship
    457
    457
    2
    Jet Blue21 ABC
    458
    458
    2
    New: Jet Blue23 ABC New: DEF New: DEF
    2
    Jet Blue23 ABC DEF DEF
    3
    EXCELL123
    123
    ABC ABC
    3
    EXCELL123
    123
    ABC ABC
    3
    Toyota Supra
    460
    460
    3
    Toyota Supra
    460
    460
    2
    Emirate ABC12345
    461
    461
    2
    Emirate ABC12345
    461
    461
    1
    Angel ABC12346
    462
    462
    MISSING: 1 MISSING: Angel MISSING: ABC12346 MISSING: 462 MISSING: 462
    2
    Jet Blue21 ABC
    458
    458
    Worksheet: Result Wanted
    A Folk, A Forum, A Fuhrer ….

  8. #18
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10

    Loop through closed workbooks without opening them

    Code for Yasser, here: http://www.eileenslounge.com/viewtop...241152#p241148



    Code:
    Option Explicit
    Sub SUMfromD14inClsdWkBksInFolder() ' Loop through closed workbooks without opening them '    http://www.eileenslounge.com/viewtopic.php?f=30&t=31150&p=241152#p241152
    ' Use Dir function with wildcards in full path and name search string to find file names you want
    Dim FileName As String:
     Let FileName = Dir("C:\Users\Elston\Desktop\YassersFolder\*record*", vbNormal) ' The Dir function uased the first time here, it will find the first file with "record" in its file name in the folder , "YassersFolder". If it does not find one,  it will return "". If it finds one, then variable FileName will be given its name, ( just the name, not the entire file path and name)
    'Do do Looping while you find the file names you want =========
        Do While Not FileName = "" ' Dir Function will return "" if it finds no new File names of the ones looking for. If it does find a File name, then use that filename in the closed workbook reference which you put in a spare cell, for example, A1
         Let ThisWorkbook.Worksheets.Item(1).Range("A1").Value = "=" & "'" & "C:\Users\Elston\Desktop\YassersFolder\" & "[" & FileName & "]Tabelle1'!$D$14"
        Dim SomeTotal As Double ' A variable to hold the Sum total so far
         Let SomeTotal = SomeTotal + ThisWorkbook.Worksheets.Item(1).Range("A1").Value
         Let FileName = Dir ' an unqualified Dir will look again using the last search criteria, so the first time this line is used, Dir Function  will try to find a second file with the string part "record" in its file name
        Loop '  do while you find the file names you want ==========
    Let ThisWorkbook.Worksheets.Item(1).Range("A10").Value = SomeTotal
    End Sub
    A Folk, A Forum, A Fuhrer ….

  9. #19
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10

    Named Ranges scope defines the default path used for a named range, nothing else

    Codes to support this
    https://www.thespreadsheetguru.com/b...ent-4189507335

    ....

    The main demo code is Sub NamedRangeScopes() , but that Calls the others, so copy them all to the same code module , and then run the main demo code, Sub NamedRangeScopes()

    Code:
    Sub NamedRangeScopes()
    10    Call FukOffNames
    20    Call getWbNames
    30   Rem 1 Add 3 named ranges, 1(i) '_-in the Workbooks name object collection, and 1(ii) in the first worksheet name object collection and 1(iii) '_-in the second worksheet name object collection
    40   '1(i) Add a Workbook names object in the Workbook name object collection of this workbook
    50    ThisWorkbook.Names.Add Name:="Name1", RefersTo:=ThisWorkbook.Worksheets.Item(1).Range("A1")   '_-in the Workbooks name object collection
    60    'The form above is like   ThisWorkbook.Names.Add Name:="Name1", RefersTo:=Worksheets(Sheet1).Range("A1")
    70   '1(ii) Add a name object in the first worksheet's name object collection
    80    ThisWorkbook.Worksheets.Item(1).Names.Add Name:="Name1", RefersTo:=ThisWorkbook.Worksheets.Item(1).Range("A1")  '_-in the first worksheet name object collection
    90    'The form above is like   Worksheets("Sheet1).Names.Add Name:="Name1"  ,    RefersTo:=Sheet1.Range("A1")
    100  '1(iii) Add a name object in the second worksheet's name object collection
    110   ThisWorkbook.Worksheets.Item(2).Names.Add Name:="Name2", RefersTo:=ThisWorkbook.Worksheets.Item(2).Range("A1")  '_-in the second worksheet name object collection
    120   'The form above is like   Worksheets("Sheet2).Names.Add Name:="Name2"  ,    RefersTo:=Sheet2.Range("A1")
    130  Rem 2 Change the string name of a named range
    140   Call GetChaNameObjects(140) ' Check out Info for all Name objects
    150  '2a) Use Workbook names objects to Change the worksheet names object name that has the same name as the workbook names object name, change it twice, first using the workbook names object collection and then the worksheet names object collection
    160   Let ThisWorkbook.Names(ThisWorkbook.Worksheets.Item(1).Name & "!" & "Name1").Name = "Name1_1"
    170   '       The form above is like             ThisWorkbook.Names("Sheet1!Name").Name = "Name1_1"
    180   Call GetChaNameObjects(180)
    190   Let ThisWorkbook.Worksheets.Item(1).Names(ThisWorkbook.Worksheets.Item(1).Name & "!" & "Name1_1").Name = "Name1_2"
    200   Call GetChaNameObjects(200)
    210   Let ThisWorkbook.Worksheets.Item(1).Names("Name1_2").Name = "Name1_3"
    220   Call GetChaNameObjects(220)
    230  '2b) use a Worksheet's (in this example the second worksheet's) name objects to Change the second worksheet's names object, ( we gave it "Name2", but Excel adds a bit so it looks like  Sheet2!Name2" which you can get from a VBA code line like  ThisWorkbook.Worksheets.Item(2).Name & "!" & "Name2"   I do this just in case your second worksheet has a tab name other than  Sheet2
    240   Let ThisWorkbook.Worksheets.Item(2).Names("Name2").Name = "Name2_2"
    250   ' Note: you could have equally done this:     Let ThisWorkbook.Worksheets.Item(2).Names(ThisWorkbook.Worksheets.Item(2).Name & "!" & "Name2").Name = "Name2_2"  , which is like   Let ThisWorkbook.Worksheets.Item(2).Names("Sheet2!Name2").Name = "Name2_2"
    260   Call GetChaNameObjects(260)
    270  Rem 3 Change the string name of a named range, for example the one in the second worksheet names collection whichg we just renamed to "Name2_2" ,(which Excel holds as like  "Sheet2!Name2_2")
    280  '3a) Use Workbook names objects
    290   Let ThisWorkbook.Names(ThisWorkbook.Worksheets.Item(2).Name & "!" & "Name2_2").RefersTo = ThisWorkbook.Worksheets.Item(2).Range("Z123")
    300   Call GetChaNameObjects(300)
    310  '3b) Use the second worksheets's  names objects
    320   Let ThisWorkbook.Worksheets.Item(2).Names("Name2_2").RefersTo = ThisWorkbook.Worksheets.Item(2).Range("X23")
    330   Call GetChaNameObjects(330)
    End Sub
    Code:
    Sub FukOffNames()
    Dim Nme As Name
         For Each Nme In ThisWorkbook.Names
          Nme.Delete
         Next Nme
    End Sub
    Code:
    Sub GetChaNameObjects(ByVal CodLn As Long)
    Dim Nme As Name, strOut As String
    ' Name objects belonging in Workbook Names Colection (Workbooks scope)
         For Each Nme In ThisWorkbook.Names
            If InStr(1, Nme.Name, "!", vbBinaryCompare) > 0 Then ' we will see that a name for a worksheet scope, has an extra bit added onto the name we gave it which includes a "!"
             Let strOut = strOut & "Name object Name is  """ & Nme.Name & """ (you gave """ & Mid(Nme.Name, 1 + InStr(1, Nme.Name, "!", vbBinaryCompare)) & """)" & vbCrLf & "It has worksheet scope and" & vbCrLf & "it refers to range  """ & Nme.RefersTo & """" & vbCrLf & vbCrLf & vbCrLf
            Else ' we will see that a name for a workbook scope, remains just as we gave it
             Let strOut = strOut & "Name object Name is  """ & Nme.Name & """ (the same as you gave)" & vbCrLf & "It has workbook scope and" & vbCrLf & "it refers to range  """ & Nme.RefersTo & """" & vbCrLf & vbCrLf & vbCrLf
            End If
        Next Nme
     MsgBox prompt:="Workbook names situation at Code Line " & CodLn & vbCrLf & vbCrLf & strOut, Title:="Name objects in Workbook """ & ThisWorkbook.Name & """ Names Colection are:-": Debug.Print "Name objects in Workbook """ & ThisWorkbook.Name & """ Names Colection are:-" & vbCr & strOut
    ' Name objects belonging in Workbooks Names Colection (Worksheets scope)
    Dim Ws As Worksheet: Let strOut = ""
        For Each Ws In ThisWorkbook.Worksheets
            For Each Nme In Ws.Names
             Let strOut = strOut & "Name object name is  """ & Nme.Name & """ (you gave """ & Mid(Nme.Name, 1 + InStr(1, Nme.Name, "!", vbBinaryCompare)) & """)" & vbCrLf & "It has worksheets scope and" & vbCrLf & "it belongs to the Names collection of worksheet """ & Ws.Name & """" & vbCrLf & "and it refers to range  """ & Nme.RefersTo & """" & vbCrLf & vbCrLf
            Next Nme
        Next Ws
     MsgBox prompt:="Worksheets names situation at Code Line " & CodLn & vbCrLf & vbCrLf & strOut, Title:="Name objects in all the worksheets Names Colections are:-": Debug.Print "Name objects in all the worksheets Names Colections are:-" & strOut
    End Sub
    Code:
    Sub getWbNames()
    Dim Nme As Name, Cnt As Long
        For Each Nme In ThisWorkbook.Names
         Let Cnt = Cnt + 1
        Dim strNames As String: Let strNames = strNames & Cnt & "   "
            If TypeOf Nme.Parent Is Worksheet Then '   https://stackoverflow.com/questions/8656793/progammatically-determine-if-a-named-range-is-scoped-to-a-workbook
             Let strNames = strNames & """" & Nme.Name & """  refers to the range ref  """ & Nme & """  and and can be referenced only from worksheet with tab Name  """ & Nme.Parent.Name & """ ( Worksheet Scope ). ( That worksheet is in the workbook  """ & Nme.Parent.Parent.Name & """  )" & vbCrLf & vbCrLf
            Else
             Let strNames = strNames & """" & Nme.Name & """  refers to the range ref  """ & Nme & """  and can be referenced from any sheet in the Workbook  """ & Nme.Parent.Name & """  ( Workbook Scope )" & vbCrLf & vbCrLf
            End If
        Next Nme
        If strNames = "" Then
         MsgBox prompt:="I don't think you have any Names at the moment luvy"
        Else
         MsgBox prompt:=strNames, Title:="Spreadsheet Named range objects in " & ThisWorkbook.Name & " are:-": Debug.Print strNames
        End If
    End Sub
    A Folk, A Forum, A Fuhrer ….

  10. #20
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,459
    Rep Power
    10

    Further Practice with using named ranges

    First main Demo code in support of this Thread:
    http://www.excelfox.com/forum/showth...-a-named-range
    Posts from approximately here:
    http://www.excelfox.com/forum/showth...814#post10814:



    Code:
    Sub FoxySingleCellNamedRanges()
    10   Rem -2 Range Info etc.
    20   Dim WbMain As Workbook, dataWb1xls As Workbook, dataWb2xlsx As Workbook
    30    Set WbMain = Workbooks("MasturFile.xlsm") 'Set WbMain = ThisWorkbook
    40    Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls"
    50    Set dataWb1xls = Workbooks("Data1.xls")
    60    Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx"
    70    Set dataWb2xlsx = Workbooks("Data2.xlsx")
    80 '
    90   Dim LisWkBkPath As String: Let LisWkBkPath = "=" & "'" & ThisWorkbook.Path & "\"
    100  '-2b) Some variables to hold a full reference string which we will use in places where we might need any of these variations for a cell reference  Sheet7!B5  [myWorkbook.xlsm] Sheet4!B5  'G:\Desktop\MyFolder\[DataFile.xlsx]Tabelle1'!B5   The last one is the form we hold in the variables. Excel and Excel VBA , usually has no issues if you use the full reference in situations where one of the shorter versions may have been sufficient. But on the other hand,  you may get unexpected problems if you used a shorter version , and Excel then  guesses wrongly  for the remaining part, which I believe it always adds internally, ( possibly at some compiling stage ) , before it uses it.
    110  Dim MBkTab1B5 As String ' To hold full string reference to B5 in Master Workbook
    120   Let MBkTab1B5 = "=" & "'" & ThisWorkbook.Path & "\" & "[" & "MasturFile.xlsm" & "]" & "Tabelle1" & "'" & "!" & "B5"
    130  Dim Dat1Tab1B5 As String ' B5 in data1 workbook
    140   Let Dat1Tab1B5 = "=" & "'" & ThisWorkbook.Path & "\" & "[" & "Data1.xls" & "]" & "Tabelle1" & "'" & "!" & "B5"
    150
    160  Rem -1 Error handler
    170   On Error GoTo ErrorHandlerCodeSection:
    180  GoTo PastErrorHandler
    190 ErrorHandlerCodeSection:
    200   MsgBox prompt:="Code errored at line  " & Erl & " , error was:" & vbCrLf & vbCrLf & Err.Number & "     " & Err.Description
    210   Debug.Print Err.Number & "     " & Err.Description
    220   Resume Next
    230 PastErrorHandler:
    240  Rem 0 Clean up
    250  Dim WkBk As Workbook
    260      For Each WkBk In Workbooks
    270       Call FukYaWkBkNames(WkBk)
    280       'Call GeTchaNms(280, WkBk)
    290      Next WkBk
    300   Workbooks("Data1.xls").Close savechanges:=True
    310   Workbooks("Data2.xlsx").Close savechanges:=True
    312  '0b) clear the entire data ranges in the first worksheet in the main workbook, both headers and data
    315   ThisWorkbook.Worksheets.Item(1).Range("B5:C12").ClearContents
    320  Rem _1) Data1 "Food" header
    330  '1a) Data1 cell Workbook Scoped to its workbook : Info needed for a range in that data file is held in the workbooks name objects collection object of that workbook
    340   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls"
    350   Set dataWb1xls = Workbooks("Data1.xls") ' We need this open for the referred to range in the RefersTo:= range reference below
    360   dataWb1xls.Names.Add Name:="Dta1Foodheader", RefersTo:=Application.Range(Dat1Tab1B5) ' A personal preference of mine is , once again, to use a full reference. This time it is  in the Refers To range. This Refers To:= argument would never need the full file path reference, as the range referenced must be to a range in an open book. Never the less, as usual, VBA accepts the full reference
    370   Call GeTchaNms(370, dataWb1xls)
    380   dataWb1xls.Close savechanges:=True ' I don't need the workbook open for the next line to work, but I made Added a named range object so I must save the changes for the next line to work as that named range is referenced
    390   Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "Data1.xls'!Dta1Foodheader" ' "Going" to Workbook  Data1.xls
    400   Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "[Data1.xls]Tabelle4'!Dta1Foodheader" ' "Going" to any worksheet in  Data1.xls
    410  '1b) Data1 cell Worksheet Scoped to one of its worksheets: Info needed is held in the named objects object of its second worksheets
    420   Rem _1 Add some named ranges
    430   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls"
    440   Set dataWb1xls = Workbooks("Data1.xls") ' We need this open for the referred to range in the RefersTo:= range reference below
    450   dataWb1xls.Worksheets.Item(2).Names.Add Name:="Ws2Dta1Foodheader", RefersTo:=Application.Range(Dat1Tab1B5)
    460   Call GeTchaNms(460, dataWb1xls)
    470   dataWb1xls.Close savechanges:=True ' I don't need the workbook open for the next line to work, but I made Added a named range object so I must save the changes for the next line to work as that named range is referenced
    480   Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "[Data1.xls]Tabelle2'!Ws2Dta1Foodheader"
    490  '1b)(ii)
    500   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls"
    510   Set dataWb1xls = Workbooks("Data1.xls") ' We need this open for the referred to range in the RefersTo:= range reference below
    520   Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "[Data1.xls]Tabelle2'!Ws2Dta1Foodheader"
    530   dataWb1xls.Close savechanges:=False ' I made no changes intentionally , so save without changes in case I accidentally changed anything
    540  '1c) Data1 cell Workbook Scoped to a different (open) workbook : Info needed for a range in the data 1 file is held in the workbooks name objects collection object of that workbook, the main file in this case
    550   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls"
    560   Set dataWb1xls = Workbooks("Data1.xls") ' We need this open for the referred to range in the RefersTo:= range reference below
    570   WbMain.Names.Add Name:="MainDta1Foodheader", RefersTo:=Application.Range(Dat1Tab1B5)
    580   dataWb1xls.Close savechanges:=False ' I had this open for the  Refers To:=  above, but I did not change anything, for example, this time i was not doing anything to any of its named range objects, so just iin case I accidentally changed anything I will close without saving any changes
    590   Call GeTchaNms(590, WbMain)
    600   Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "MasturFile.xlsm'!MainDta1Foodheader" ' "Going" to Workbook  MasturFile.xlsm
    610   Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "[MasturFile.xlsm]Tabelle4'!MainDta1Foodheader" ' "Going" to any worksheet in MasturFile.xlsm
    620  '1d) This is an attempt to get at the named range object in a roundabout sort of a way. Here the data 1 cell s scoped to the second data file, "Data2.xlsx" ( Workbooks scoped to workbook "Data2.xlsx" )
    630   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls"
    640   Set dataWb1xls = Workbooks("Data1.xls")
    650   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx"
    660   Set dataWb2xlsx = Workbooks("Data2.xlsx")
    670   dataWb2xlsx.Names.Add Name:="Dta2Dta1Foodheader", RefersTo:=Application.Range(Dat1Tab1B5)
    680   Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "Data2.xlsx'!Dta2Dta1Foodheader" ' "Going" to Workbook  MasturFile.xlsm
    690   dataWb1xls.Close savechanges:=False ' I had this open for the  Refers To:=  above, but I did not change anything, for example, this time i was not doing anything to any of its named range objects, so just iin case I accidentally changed anything I will close without saving any changes
    700   dataWb2xlsx.Close savechanges:=True ' A name object was Added, so I have a change to save
    710   Let Application.Range(MBkTab1B5).Value = Application.Range(MBkTab1B5).Value ' I have done this here to "catch" the value put in, as it seems to vanish if I re enter the formula ??
    720  Rem 2 Experiments with named ranges in the LHS , like in Range("rngNamed") =
    730  '2a) scope to a data file
    740   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx"
    750   Set dataWb2xlsx = Workbooks("Data2.xlsx") ' Open an arbritrary data file to use one if its names objects as the place to go to get the info about the named range
    760   dataWb2xlsx.Names.Add Name:="Dta2MainFoodheader", RefersTo:=Application.Range(MBkTab1B5)
    770   Call GeTchaNms(770, dataWb2xlsx)
    780   Let Application.Range(LisWkBkPath & "Data2.xlsx'!Dta2MainFoodheader").Value = LisWkBkPath & "Data1.xls'!Dta1Foodheader" ' LHS is going to workbook Data2.xlsx     RHS is "Going" to Workbook  Data1.xls
    790   dataWb2xlsx.Close savechanges:=True ' A name object was Added, so I have a change to save
    800   Let Application.Range(LisWkBkPath & "Data2.xlsx'!Dta2MainFoodheader").Value = LisWkBkPath & "Data1.xls'!Dta1Foodheader" ' LHS is going to workbook Data2.xlsx      RHS is "Going" to Workbook  Data1.xls
    810  '2b) Workbooks Scope to main workbook: Info for named range is in Name Objects collection of Main workbook
    820   WbMain.Names.Add Name:="MainFoodheader", RefersTo:=Application.Range(MBkTab1B5)
    830   Let Application.Range(LisWkBkPath & WbMain.Name & "'!MainFoodheader").Value = LisWkBkPath & "Data1.xls'!Dta1Foodheader" ' LHS is going to workbook Data2.xlsx      RHS is "Going" to Workbook  Data1.xls
    840   Call GeTchaNms(840, WbMain)
    850  Rem 3 Bring in Header "Suppliment" from data 2 workbook directly without named ranges
    860   Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx"
    870   Set dataWb2xlsx = Workbooks("Data2.xlsx") ' Needed for next line
    880   Let Application.Range("=" & "'" & WbMain.Path & "\" & "[" & WbMain.Name & "]" & WbMain.Worksheets.Item(1).Name & "'" & "!" & "B10").Value = "=" & "'" & dataWb2xlsx.Path & "\" & "[" & dataWb2xlsx.Name & "]" & dataWb2xlsx.Worksheets.Item(1).Name & "'" & "!" & "B10"
    890   dataWb2xlsx.Close savechanges:=False
    End Sub
    A Folk, A Forum, A Fuhrer ….

Similar Threads

  1. Replies: 185
    Last Post: 05-22-2024, 10:02 PM
  2. Tests and Notes for EMail Threads
    By DocAElstein in forum Test Area
    Replies: 29
    Last Post: 11-15-2022, 04:39 PM
  3. Replies: 379
    Last Post: 11-13-2020, 07:44 PM
  4. Appendix Thread. Diet Protokol Coding Adaptions
    By DocAElstein in forum Test Area
    Replies: 6
    Last Post: 09-05-2019, 10:45 AM

Posting Permissions

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